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Summary 


Last year, several programs designed to run on a PC computer were 
developed for MSFC. These codes covered the low, intermediate, and 
high frequency modes of oscillation of a liquid rocket propulsion 
system. No graphics were built into these programs and only simple 
piping layouts were supported. This year’s effort has been to add run 
time graphics to the low and Intermediate frequency codes, allow new 
types of piping elements (accumulators, pumps, and split pipes) in the 
low frequency code, and develop a new code for the PC to generate 
Nyquist plots. 
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Introduction 


This year began with the computer programs at the stage described in 
NASA Contractor Report 5-32176, June 1990. The programs written for 
the Macintosh had plot capability, but were slow because of the 
interpretive language used. Programs for the PC were written in 
FORTRAN to increase the speed of execution. The PC programs discussed 
in Report 5-32176 contained no graphics. 

This year, the PC programs were expanded to include graphics and to 
address more types of feedline elements. The effort this year was 
primarily in the low frequency area. In addition to the admittance 
calculations, the pressure transfer function was evaluated. A new PC 
program was written to generate the Nyquist plots already implemented 
on the Macintosh. Graphics were added to the intermediate mode 
program. Frequency may be input (and output) in either radians per 
second or in Hertz. 

This report will trace the development of these enhancements. A 
summary of the working equations for impedance are presented first. 
Then, the equations are derived for each of the types of piping 
elements handled: straight piped, inline accumulator, tuned stub, 
Helmholtz resonator, parallel resonator, pumps, and split pipes . The 
bend is handled as an equivalent straight pipe based on the procedure 
presented in NASA Contractor Report 5-32176. All impedances are 
nondimensional ized by chamber pressure divided by chamber mass flow 
(pc/rfic). In the split pipe case, this factor for one engine is 
multiplied by the number of engines [m*(pc/ii>c)] . 

The Nyquist program is discussed next. The equations used are 
presented. In addition the Nyquist plots, phase-gain plots have 
been added. 

The primary modifications to the intermediate mode program concern 
simplifying the operation and the plotting of the n vs t curves. 

There were no modifications to the high frequency program made this 
year. However, the code was used to study the stability of a couple 
of engines (see Appendix A). 
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Feedline Program 

The feedline program has undergone extensive enhancements. The 
addition of graphics allows the user to run a case, look at the 
results, interactively modify the input, and repeat the cycle. All 
this may be done with one running of the code. Also, the input was 
rearranged into a more useful form for this type interactive 
operation. 

The addition of graphics made it feasible to add the pressure transfer 
function to the code. This required restructuring the logic of the 
program. The original program was only required to compute the 
admittance looking toward the tank. The calculation of the pressure 
transfer function required the computation of impedance looking toward 
the engine. 

Major changes to the code were required to accommodate more complex 
pipe layouts. The most complex addition was allowing a line to split 
into m identical lines. This calculation requires an iteration to 
determine the impedances. The addition of four types of accumulators 
was more straight forward. Inline accumulators, tuned stubs, 

Helmholtz resonators, and parallel resonators may be handled by the 
program. A pump also may be included in the piping layout. 

The first graphics incorporated into the program displays the piping 
layout in the upper half of the screen and the admittance vs frequency 
curve in the lower half of the screen. A split pipe is represented by 
only one of the m identical lines. Accumulators are all shown as on 
the upper part of the pipe. The drawing of the pump has not been 
added to the graph. 

A surface plot and a contour plot were added to display the pressure 
transfer function vs frequency and distance. The surface plot may be 
displayed from any viewpoint and as a solid surface or a wire-frame 
drawing. The contour plot displays nine contour lines with the values 
of lines 1, 5, and 9 displayed. 

All aspects of the plots are under the control of the user. Defaults 
are set by the program, but these are easily changed. The colors used 
may be changed and these remain in effect until changed again. Colors 
are assigned separately to the three graphs. The surface plot and 
contour plot may be bypassed. The pipe layout - admittance graph is 
always displayed, but the admittance curve may be plotted as the 
calculations are made or after they are finished. 
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These enhancements to the feed line program will be illustrated by a 
series of runs. The four type of accumulators will be compared to the 
same layout without an accumulator. The results for the basic 
configuration are shown in Figure 1. The pipe layout and admittance 
vs frequency curve are in Figure la, the surface plot of the pressure 
transfer function vs frequency and location is in Figure lb, and a 
contour plot of the pressure transfer function is in figure 
lc. The peak pressure appears to occur after the second bend from the 
tank. The accumulators will be inserted at this point. 

It should be noted that a coarse grid may underestimate the peak. In 
all cases run, the finest grid available was run to obtain the peak, 
then a coarser grid with the same peak was run to produce the plots. 
For example, the surface shown in Figure lb was generated using 33 
frequencies between 1 and 30 Hertz. The code was run again using 34 
frequencies over the same interval giving the surface in Figure 2. 

The user must be aware of this problem and act accordingly. 

An Inline Accumulator was inserted and the code rerun. The 
accumulator was 2 ft. long with a diameter of 4 ft. No attempt was 
made to minimize the peak, only to reduce it significantly. The 
results are given in Figure 3 which shows a drop in the peak pressure 
of 80%. 

Next, a Tuned Stub was used. It was 10.5 ft. long and had a 0.74 ft. 
diameter. Figure 4 presents the results. The reduction in peak 
pressure was 70% for this configuration. 

A Helmholtz Resonator with a 0.001 ft. diameter stem 0.4 ft. long 
leading to a volume of 5 ft 3 was run (Fig. 5). This reduced the peak 
pressure by 72%. 

The last accumulator was a Parallel Resonator 1 ft. long with a 
diameter of 0.05 ft. It bypassed a volume of 1 ft 3 . Figure 6 shows 
the results of the run. This configuration reduced the peak pressure 
by only 47%. Remember, this configuration was not fine tuned as only 
a reduction in the peak was desired. 

The effect of splitting a pipe into three identical lines going to 
identical engines was investigated by first running a case where the 
pipe is unsplit, but has an area equivalent to the three pipes. The 
results of the unsplit pipe are shown in Figure 7. Then the split 
pipe case was run giving the results shown in Figure 8. These figures 
show that a split pipe cannot be properly analyzed using an equivalent 
single pipe. 
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Summary of Equations for Impedance 
In the following equations, n = s/a. 

1. Straight Pipe 

Zt(I-l) + Zo(I) *tanh(n*1 ) 

Zt (I) = Zo (I) - [ ] 

Zo (I) + Zt(I-l) *tanh(n*l) 

Zg(I) = {e n 1 *[Zo(I+l) + Zg ( 1+ 1 ) ] • ( 1 - N*M*e -2 * n •’ ) 

~ Zo(I+l) *(1 - N*e -2 • n * 1 •e 2,n * 1 i)}/(l + n * e' 2 >n • 1 *e 2 • n #1 1 ) 
where N = [Zo(I+l) - Zt(I-l)]/[Zo(I+l) + Zt(I-l)] 

M = [Zo (1+1) - Zg (1+1 ) ]/[Zo (1+1 ) + Z g ( 1+1 ) ] 

1 = L ( I ) + L(I+1) 

h = L(I+1) 

2. Inline Accumulator 
Z.=l/(C-s) 

Zt(I) = Z.-Zt(I-l)/[Zt(I-l) + Zm] 

Zg ( I ) = Z.*Zg(I+l)/[Zg(I+l) + Z.] 

3. Tuned Stub 

Z« = Zo/tanh(n*l) 

Zt(I) = Z.-Zt(I-l)/[Zt(I-l) + Zb] 

Zg ( I ) = Z.-Zg(I+l)/[Zg(I+l) + Z. ] 

4. Helmholtz Resonator 

Zrn - (1 + L-C-s 2 )/(C-s) 

ZtU) = Z.*Zt(I-l)/[Zt(I-l)+Z.] 

Zg ( I ) = Z.-Zg(I+l)/[Zg(I+l)+Z.] 
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5. Parallel Resonator 


Z. = L-s/Cl + L-C-s 2 ) 

Zt(I) = Zt(I-l) + Z. 

Zg ( I ) = Zg ( 1+ 1 ) + Z. 

6. Pump 

ap 

Zp = 

dill 

Zt(I) = {Zt(I-l) + (Zp + L *s) • [ 1 + Zt(I-l) *C*s]}/[l + Zt (1-1) *C*s] 
Zg (I) = [L-S - Zp + Zg ( 1 + 1 ) ]/{ 1 + C-S-[L-S - Zp + Zg ( 1+ 1 ) ] } 

7. Split Pipe 

Z. = Zg ( I— 1 ) *Zt (I— 1 )/[ (m-1) *Zt (1-1) + Zg(I-l)] 

Z. + Zo(I)-tanh(n-l) 

Zt(I) = Zo (I) • [ ] 

Zo(I) + Z«*tanh(n*l) 

Zg ( I ) = {e 0 * 1 ! *[Zo(I+l) + Zg (1+1 ) ] • ( 1 - N-M-e- 2 *"* 1 ) - Zo(I+l) 

•(1 — N'e -2 * 0 *^ *e 2 * n * 1 i )}/[ m*(l + N *e - 2 .n • i . q 2 .n . i j ) j 
where N = [Zo(I+l) - Zt(I-l)]/[Zo(I+l) + Zt(I-l)] 

M = tZo(I+l) - Zg(I+l)]/[Zo( 1+1 ) + Zg ( 1+1 ) ] 

1 = L(I) + LCI+1) 

li = L( 1+1 ) 
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Straight Pipe 


The equation for the pressure at any point in a pipe is derived on 
page 25 of NASA Contractor Report 5-32176. 

p(x,s) Zo e -n * x - N*e -n • 1_x ) 

= ( )•[ ] 

Pg (s) Zo + Z g 1 - N*M*e~ 2 * n • 1 

where n = s/a 

Zo - Zt 

where N = 

Zo + Zt 


Zo — Zg 

M = 

Zo + Zg 

Consider the case where the pipe is divided into two sections: 


Z’t 


1\ 


I2 


•>!<- 


li 


Case 1. Solve for Zt. Zg is the same for 1 and li 

Zo e _n * x - N*e -n *< 2 • 1 ~ x > 

( ) . [ ] 

Zo + Zg 1 - N*M*e~ 2 * n • 1 

Zo 0“ ^ 

= ( )•[ ] 

Zo + Zg 1 - N’ -M-e* 2 -"- 1 ! 


evaluate at x = li 


e _n . 1 i - N. e -n .(2 .1-lj) 

( ) 

1 - N*M*e -2 * n • 1 


e~ n • 1 1 

= [ 

1 - 


- n' * e _n *(2 • 1 i -1 1 ) 

] 

N* *M*e" 2 * n • 1 1 
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0 — n * 1 ^ » 0~ 2 »n » 1 ign « 1 ^ 


( 


i 


N *M*e ~ 2 •" • 1 


e -n .1 1 - N’ *e -n • 1 1 

) = ( ) 

1 - N’ -M-e" 2 • n - 1 i 


1 — N *6“ 1 - N 1 

( ) = ( ) 

1 - N‘M’6 -2 * n • 1 1 - N’ •M*e- 2 * n * 1 i 

(1 - N *e - 2 ,n • 1 *e 2 ,n • 1 1 ) • ( 1 - N 1 *M *e - 2 * n • 1 i ) 

= (1 - N’ ) • (1 - N-M-e- 2 -"- 1 ) 

1 - N-e -2 •" -e 2 •" i - N’ *M«e- 2 * n •’ i + N*N’ *M*e -2 >n 

= 1 - N’ - N*H*e -2 * n • 1 + N*N’ -M*e- 2 •" - 1 
(1 ~ M *e- 2 * n • ^ 1 ) • N ’ = (e 2 * n i — M) •N*e -2 ,n - 1 

fi| * z N .g- 2 ,n . 1 .g2.n.l^ 

but, 1 2 = 1 — 1 i , therefore 

N’ = N^e -2 * 0 *^ = N*[cosh(2*n*l2) - sinh( 2 *n*l 2 )] 

N’ = N*[cosh 2 (n*l 2 ) + sinh 2 (n*l 2 ) - 2 *cosh(n*l 2 )*sinh(rvl 2 )] 2 

N’ = N • [cosh(n • I 2 ) - sinh(n*l 2 )] 2 

1 tanh(rcl 2 ) 

N’ = N • { }2 

sqrt[l - tanh 2 (n*l 2 )] sqrttl - tanh 2 (n*l 2 )] 

[1 - tanh(n*l 2 )] 2 1 - tanh(rrl 2 ) 

N’ = N • { } = n • [ ] 

1 - tanh 2 (n*l 2 ) 1 + tanh(n*l 2 ) 

let 1 2 = 1 and expand N and N’ 

Zo - Z’t Zo - Zt 1 - tanh(n-l) 

C ) = ( )•[ ] 

Zo + Z’t Zo + Zt 1 + tanh(n*l) 

(Zo - Z’t)*(Zo + Zt ) * [ 1 + tanh(n*l)] 

= (Zo - Zt)*(Zo + Z’t)*[l - tanh(n*l)] 
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(Zo 2 + Zo-Zt - Zo'Z’t - Zt*Z’t)*[l + tanh(n-l)] 

= (Zo 2 - Zo-Zt + Zo-Z’t - Zt-Z’t)-[1 - tanh(n-l)] 
Zo-(Zt-Z’t) + (Zo 2 - Zt -Z’t ) -tanh(n-l ) 

= -Zo-(Zt-Z’t) - (Zo 2 - Zt -Z’t) -tanh(n-l) 
Zo-(Zt-Z’t) + (Zo 2 - Zt -Z’t ) -tanh(n-l ) = 0 
[Zo + Zt -tanh(n- 1 )] -Z’t = Zo-[Zt + Zo -tanh(n-l )] 


Zt + Zo-tanh(n-l) 
Z’t = Zo • [ ] 


Zo + Zt -tanh(n- 1 ) 


or, 


Zt(I-l) + Zo(I)-tanh(n-l) 

Zt(I) = Zo(I) * [ ] 

Zo(I) + Zt(I-l) -tanh(n-l ) 


Case 2. Solve for Zg. Zt is the same for 1 and I 2 


Zo 


e -n .x _ n »e _n • ( 2 .1 -x) 

■) * [ ] 


Zo + Z g 1 - N-M-e’ 2 -"- 1 

= ( 


Zo ©~ ^ * — ^•@“^•(2*12”^) 

) • [ ] 


Zo + Z’g 1 - N-M’ -e-2 

evaluate at x = li for 1 and x = 0 for I 2 
1 


(- 


Zo + Zg 


— N «e - n .(2 ,1-lj) 

-) * [ ] 


1 - N-M-e _2 - n • 1 
1 


(- 


1 - N-e -2 - n • 1 2 

-) • ( ) 

Zo + Z’g 1 - N-M’ -e~ 2 - n -’2 

substitute 1 - U for I 2 
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( ) • ( ) 

Zo + Zg 1 — N-M-e -2 *"- 1 

1 1 — N-e“ 2 •" »i *e 2 •" - 1 1 


e -n .1 i 


— N*6~ 2 1 ^ 1 • 0 2 »n #T ^ 


( ) . ( ) 

Zo + Z g 1 - N-M*e~ 2 * n • 1 

1 1“ N*6 _2 * n *^ *S 2 1 i 


l )•{ 

Zo + Z’g 1 - N*M’ *e* 2 * n - 1 -e 2 * n - 1 i 


e _n • 1 1 1 

( ) • ( ) 

Zo + Zg 1 - N-M-e-2 .n -1 

1 1 

= ( )•( ) 

Zo + Z*g 1 - N-M’-e- 2 -"- 1 -e 2 -"- 1 ! 

(Zo + Z’g) -e~ n • 1 1 • ( 1 - N -M ’ -e* 2 • n • 1 -e 2 *" • 1 i ) 

= (Zo + Zg ) • ( 1 - N-M-e-2-"- 1 ) 

Zo-Z’g 

(Zo + Z ’ g ) • e~ n • 1 1 • [ 1 - N - ( ) *e“ 2 • 1 -e 2 -" - 1 i ] 

Zo + Z’g 

= (Zo + Zg ) - ( 1 - N-M-e* 2 -"- 1 ) 

(Zo + Z’g) -e" n - 1 i - N-(Zo-Z’g) -e" 2 •" - 1 -e " - 1 i 
= (Zo + Zg ) - ( 1 - N-M-e* 2 -"- 1 ) 

Zo + Z’g - N • ( Zo~Z ’ g ) -e _ 2 •" • 1 -e 2 •" • 1 i 

= e" - 1 i • (Z o + Zg ) • ( 1 - N-M-e“ 2 •" - 1 ) 

Zo - ( 1 “ N -e _ 2 • 1 • e 2 ♦ 1 1 ) + Z’g-(1 + N-e“ 2 •" *i *e 2 -" - 1 i ) 
z e n-1 i-(Zo + Zg ) • ( 1 - N-M-e- 2 -"- 1 ) 
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Z ’ g • ( 1 + N-e- 2 - n •’ *e 2 * n - 1 1 ) = e n * 1 i«(Zo + Z g )-(1 - N-M*e- 2 •" - 1 ) 

- Zo • ( 1 — N *6” 2 .n . l . q 2 .n .1 j ) 

z’g = [ e n •• 1 1 * ( Zo + Z g ) • ( 1 - N*M-e -2 * n • 1 ) - Zo*(l - N*e' 2 • " -i -e 2 •" • 1 i)] 
/ ( 1 + N • 6 “ 2 • n . 1 >g2 >n >1 j ^ 
or, 

N = [Zo(I+l) - Zt(I-l)]/[Zo(I+l) + Zt(I-l)] 

M = [Zo(I+l) - Zg(I+l)]/[ Zo ( 1+ 1 ) + Z 9 (I+1)] 

1 = L ( I ) + L(I+1) 
li = LCI+1) 

Zg(I) = {e n • 1 1 • [Zo ( 1+1 ) + Zg(I+l)]*(l - N*M*e -2 * n * 1 ) 

- Zo(I+l) •(! — N*e -2 * n - 1 *e 2 * n, 'i)}/(l + N»e - 2 .n.i.g 2 .n.ij) 
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Accumulators 


Four types of accumulators will be considered: inline (manifold), 
tuned stub, Helmholtz, and parallel. For all these accumulators, the 
equations hold for either direction (Zt and Zg). For the tuned stub 
and Helmholtz resonator, the admittance seen by the next element is 
the sum of the admittance of the preceding element and the admittance 
of the accumulator. 

The following equations hold for each of the types of accumulators. 


A = 

n*d 2 /4 

ft 2 

a = 

V gc*k//° 

ft/sec 

C = 

(V/ a 2 ) • (pc/mc ) = ( /° • V/k ) *(pc/ihc) 

sec 

L = 

[l/(gcA)]/(p c /mc) 

sec 

V = 

1-A 

ft 3 

y = 

C*s 

nd 

z = 

L *S 

nd 

Zo : 

= V z/y = / L/C 

nd 

V z 

•y = s*/ L *C 

nd 


1. Inline accumulator 


V 

P 

k 


The inline accumulator is analogous to a manifold which is a 
capacitor circuit. 
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1/Z 2 = 1/Za + 1/Zi 
1/Z2 = (Zl + Za )/ (Zl *Ze ) 

Z 2 = Zl *Za/(Za + Zl) 
or, 

Zt(I) = Zt(I-l)-Z./[Za + Ztd-l)] 
Zg (I) = Zg ( 1+1 ) *Za/[Za + Zg(I+l)] 
2. Tuned Stub 


d 


/° 1 
k 


Z 2 Zi 


The tuned stub considered has no net flow through it. Thus the 
termination impedance -> • and the impedance of a pipe becomes 

Za = Zo/tanh(n*l) 

I/Z 2 = 1/Z. + 1/Zi 

Z 2 = Za *Zi/ (Zi + Za) 
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or, 


Zt(I) = Ze *Zt (I l)/[Zt (I — 1) + Ze] 
Zg ( I ) = Ze *Zg ( 1+1 )/[ Zg ( 1+1 ) + Ze] 

3. Helmholtz Resonator 



The Helmholtz resonator is analogous to a series resonant circuit. 



where L is based on the dimensions of the small pipe, and C is 
based on the large cavity, thus 

Z® = L-s + l/(C-s) 

Z. = (1 + L-C-s2)/(C-s) 

1/Z2 = 1/Ze + 1/Zi 

Z 2 = Ze *Zi/ (Zi+Ze ) 


or, 

Zt(I) = Ze *Zt ( I~l)/[Zt (1-1 )+Ze ] 
Zg ( I ) = Ze *Zg (!+!)/[ Zg(I+l)+Ze] 
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4. Parallel Resonator 


1 


d*— J 

1 v 


The parallel resonator is analogous to a parallel resonant circuit. 


Z e 

o 


o 

where L is based on the dimensions of the bypass line, and C is 
based on the dimensions of the volume bypassed 

1/Z« = 1/L-s + C-s 

Z. = L-s/(l + L-C-s 2 ) 

Z 2 = Zi + Zm 

Z 2 = Zi + L-s/(l + L-C-s 2 ) 
or, 

Zt(I) = Zt(I-l) + L*s/(1 + L-C-s 2 ) 

Zfl(I) = Zg ( 1+1 ) + L.s/(1 + L-C-s 2 ) 



Z 




L 
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When computing the impedance looking toward the engine use the 
negative of the slope. 





1/Zi = 
Zi = - 
or, 
Zg(I) 


1/ ( Z 2 - Zp + L-s) + C*s 
L*s - Zp + Z 2 
1 + C-s-U-s - Zp + Z 2 ) 

L*s - Zp + Zg(I+l) 

1 + C*S* [L*S - Zp + Zg ( 1+1 ) ] 
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Split Piping 

Often a main pipe from a fuel or LOX tank splits into several pipes, 
each going to a different engine. This analysis is for the case where 
the pipe is split into m identical lines going to m identical engines. 

Case I. Finding the impedance looking toward the tank (Zt). 





I 

t 

1 




d 





1-1 


I 

» 

1 

1+1 



d 







I 

1 

l 



Zt(I-l) Zt(I) 

Zg(I-l) Zg ( I ) 


Section I, looking toward the tank sees Zt(I-l) and (m-1) 
Z g (I-l)’s in parallel. Therefore the effective Z« it sees is 

1 m-1 1 

Z. Zg(I-l) Zt(I-l) 

Z. = Zg(I-l) *Zt (1-1 )/[ (m-1 ) -Zt(I-l) + Zg(I-l)] 

This Z« is used in the equations for Zt instead of Zt(I-l). 
Case II. Finding the impedance looking toward the engine (Z g ). 




1+1 i 

1-1 

1 

I 

1+1 i 

1 

1 

1 


i+i ; 


Zt(I) Zt(I+l) 

Zg ( I ) Zg ( 1+ 1 ) 


Section I, looking toward the engine sees m sections 1+1 in 
parallel. Therefore the effective Zg(I) is 1/m of that for one 
pipe. Thus, compute Zg using one pipe and then divide by m to 
obtain Zg(I). 
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Nyquist Program 


The Nyquist equations presented in NASA Contractor Report 5-32176 were 
programmed for the PC. The equations used in the Nyquist program are 
a function of the admittances Gox and Gf. The code was written to 
plot the Nyquist curves for the four cases: neither admittance used, 
Gox only, Gf only, and both admittances used. 

On page 47 of the report the following equation is derived 


e _T (1 + r) dC* r • (1 + r) dC* 

• {[1 + • ( )]*Gox + [1 - • ( )]*Gf} 

(l+0c *s) c* dr C* dr 


In order to simplify the notation, the following definitions are used: 

e -x .» 

Ki = 

(1+0C-S) 


(1 + r) dC* 

Ai = [1 + • ( )] 

C* dr 


r * ( 1 + r) dC* 

A2 = [1 ( )] 

C* dr 

Thus, the equation may be expressed as Ki*(Ai*Gox + Az*Gf) = -1. 

The equations used are 

K(ju) = 2-Ki neither admittance used, 

K(jU,Gox) = Ki *Ai Gox used, 

K(ju,Gf) = Ki >A 2 Gf used, 

K( ju,Gox ,Gf ) = Ki*(Ai+A 2 ) both admittances used. 

In addition to the Nyquist plots of these four equations, Phase-Gain 
plots are also available. 
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The program will run when there is no data available for either or 
both of the feed lines. When a line is missing, the user is only 
allowed to request plots that are available. The admittance 
calculations include all the variations in the feedline program: split 
pipes, accumulators, and pumps. 

Example plots are given in Figures 9 - 17. Figure 9 shows the fuel 
and LOX piping layouts used in the example. Figures 10 and 11 give 
the Nyquist plot and Phase-Gain plot for K(ju). Similar plots are 
shown for K(ju,Gox) in Figures 12 and 13, K(ju,Gf) in Figures 14 and 
15, and K(j(j,Gox ,Gr ) in Figures 16 and 17. Note that the curves for 
K(ju,Gox) and K(ju,Gf) are similar, but out of phase. This is evident 
in the curves for K( jU,Gox ,Gr ) . 


Intermediate Mode 

Graphics was added to the intermediate mode program and it was 
modified to run a range of frequencies and a range of t’s (sensitive 
time lag). After the range of x’s for a given frequency have been 
run and the n’s displayed on the screen, the user may request a plot 
of n vs t for that frequency (Fig. 18). After the range of 
frequencies have been run, n vs t is plotted on one graph for each of 
the frequencies (Fig. 19). 
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Recommendations 


Feed line Program 

1. Speed up iteration for split pipe. A study of the convergence 
will have to be made to determine the best approach. 

2. Generalize the split pipe to allow splits into non-identical 
pipes. This will require changing the logic of the program. 


Mitchell’s Program 

1. Make it easier to use. 

a. Reduce number of input files. Seven are now used. 

b. Use dimensioned variables on input and output. Currently 
the program requires the user to nondimensional ize the data 
before it is input. 

2. Add plots to the output. The code now outputs a file with n and 
t to be used by another program for plotting. 


Intermediate Frequency Program 

1. Add split pipe and accumulators. Since these are already 
developed for the feedline codes, adding them will be fairly 
simple. 
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Nomenclature 


a 

speed of sound 

ft/sec 

A 

area 

ft* 

C 

capacitance 

sec 

c 

capacitance per unit length 

sec/ft 

d 

diameter 

ft 

9c 

gravitational constant 

lbm-ft/lbf-sec 2 

G 

admittance 

nd 

k 

bulk modulus 

lbf/ft 2 

1 

length 

ft 

L(I) 

length of I th pipe 

ft 

L 

inductance 

sec 

L 

Inductance per unit length 

sec/ft 

m 

no. of spl it 1 ines 

nd 

if) 

mass flow 

1 bm/sec 

n 

pressure interaction index 

nd 

n 

pressure interaction factor 

1/ft 

P 

pressure 

lbf/ft 2 

s 

complex frequency 

1/sec 

V 

volume 

ft 3 

X 

distance along pipe 

ft 

y 

admittance 

nd 

z 

impedance 

nd 

Z 

impedance 

nd 

P 

density 

lbm/ft 3 

u 

imaginary part of frequency 

rad/sec 
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Subscripts 

c combustion chamber 

t looking toward tank 

g looking toward engine 

0 lossless line 


(e.g. p c ) 
( e . g . Gt ) 
(e.g. Z 9 ) 
(e.g. Zo) 
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Figure lc 
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Figure 3b 
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Figure 6c 
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Figure 7b 
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Figure 8c 
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Figure 10 
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Figure 11 
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Figure 12 
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Figure 14 
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Figure 15 
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Figure 16 
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Figure 18 
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Figure 19 


Applications of High Frequency Code 


The high frequency code (FDORC) was applied to a couple of actual 
engine designs. The first engine to be studied is described in 
"Predicted Combustion Stability Characteristics for the TRW Advanced 
Booster Application Engine", C. W. Johnson and G. R. Nickerson, 
Software and Engineering Associates, Inc., SEA SN109, May 1990. The 
750K engine and the 1 st tangential - l #t longitudinal were used as a 
check-point. 

Data for 750K Engine Analysis (LOX RP1) 


Gamma 

Temperature 
Pressure 
Chamber radius 
Chamber length 
Throat radius 
Radius RC 
Radius RE 
Angle 

Speed of sound 


= 1.202 
= 6400* F 
= 660 psi 
= 2.375’ 

= 1.4885’ 

= 1.28’ 

= 1.67’ 

= 1.67’ 

= 30* 

= 2861 ft/sec 


The results are summarized in the following table: 


Item 

n 

tau 

frequency 

acoustic frequency 

n - neutral stab, for 1046 Hz 
tau - neut. stab, for 1046 Hz 

n - neutral stab, for 1024 Hz 
tau - neut. stab, for 1024 Hz 

frequency for n=0.3087, 

tau=0. 0007182 
damping for n=0.3087, 

tau=0. 0007182 


Value 

Source 

0.3087 

SEA SN109 

0.0007182 

SEA SN109 

1046 Hz 

SEA SN109 

1024 HZ 

FDORC 

6.6062 

FDORC 

0.0001514 

FDORC 

6.2223 

FDORC 

0.0001573 

FDORC 

845.3 HZ 

FDORC 

2.3642 

FDORC 


note: In FDORC’s notation, a positive value for damping means there 
is positive damping. 


Data for the n - t curve for this case was generated using FDORC. The 
n - t curve and n, t for the 750K engine are shown In Figure A-l. 
Results from SEA SN109 lie well below the neutral stability curve. 
Thus, the two analyslses agree that the engine is stable In the 1 st 
tangential - l Bt longitudinal mode. 
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The code also was used to study a new engine proposal. The data for 
this engine is given in the following table. 

Data for New Engine Analysis (LOX H 2 ) 


Gamma 

Temperature 
Pressure 
Chamber radius 
Chamber length 
Throat radius 
Radius RC 
Radius RE 
Angle 

Speed of sound 


= 1.22 
= 6000° F 
= 360 psi 
= 23.21" 

= 18" 

= 16.4" 

= 24.63" 

= 24.63" 

= 20 ° 

= 3676 ft/sec 


Several modes of oscillation were run for this engine on the FDORC 
code. The location of the minimum points on the n - t curves are 
given in the following table. 


jj Mode 

of Osci llation 

Minimum of 

n-t Curve Occurs at 

I radial 

tangential 

axial 

n 

t (sec) 

1 

1 

0 

0.565 

0.000789 ' 

2 

1 

0 

0.497 

0.000301 


2 

0 

0.537 

0.000500 

2 

2 

0 

0.505 

0.000249 

2 

2 

1 

1.806 

0.000950 


The n - r 
A-2. The 
below the 


curve for the l Bt transverse mode (1,1,0) is shown in Figure 
engine will be stable in this mode if n for the engine falls 
curve. 
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TRW 750K Engine 

Report SEA -SN109 



Figure A-l 
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NEW ENGINE 

First Transverse Mode 



Figure A- 2 
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Append i x B 


Listing of Feedline Program 


AOOUM 
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PROGRAM ACCUM 


Program to compute and plot admittance coefficients, pipe layout, 
and pressure transfer function 

VARIABLE DIMENSION VERSION 06-27-91 

This program will handle the following type elements 

Straight pipes 
Bends 

Split pipes (into identical lines) 

Inline accumulators 
Tuned stub accumulators 
Helmholtz resonators 
Parallel resonators 
Pumps 


Variables in Commons 


/ADMCOL/ 


ADMBAC 

INTEGERS 

maximum value of admittance for plot 

ADMLIN 

INTEGERS 

line color of admittance plot 


/ARCCON/ 

XC 

REALM 

x coordinate of curve center 

VC 

REALM 

y coordinate of curve center 

RAD 

REALM 

radius of bend 

ANG 

REALM 

angle of bend in radians 

ANGLE 

REALM 

angle of bend in degrees 


/FACTOR/ 

SFAC 

REALM 

factor for frequency 


/FREQ/ 

S 

COMPLEX*8 

complex frequency 

ZT(0: 76) 

COMPLEX*8 

impedance looking toward tank 

ZO(76) 

REALM 

characteristic impedance 

ZG (76) 

COMPLEX*8 

impedance looking toward engine 


/INTVAL/ 

SECT 

INTEGER*2 

current pipe section type 

SECTN(75) 

INTEGER*2 

pipe section type 

SEGMN 

INTEGERS 

number of pipe sections 

NSEC(75) 

INTEGER*2 

no. of integration segments of a pipe section 

NPTS 

INTEGER*2 

number of x points for plot 

LOPEND 

INTEGER*2 

maximum number of iterations for split pipe 

LOPOLD 

INTEGER*2 

previous maximum number of iterations 


/NOCOL/ 


B - 2 


c 

MODE 

INTEGER*2 

graphics mode of monitor 

c 

MODET 

INTEGER*2 

text mode of monitor 

c 

NT ROWS 

INTEGER*2 

number of text rows for graphics 

c 

NTCOLS 

INTEGER*2 

number of text columns for graphics 

c 

N PROWS 

INTEGER*2 

number of pixel rows for graphics 

c 

p 

NPCOLS 

INTEGER*2 

number of pixel columns for graphics 

c 



/PIPPXY/ 

c 

X 

REALM 

x location of current centerline 

c 

XH 

REALM 

x location of current upper pipe 

c 

XL 

REALM 

x location of current lower pipe 

c 

Y 

REALM 

y location of current centerline 

c 

YH 

REALM 

y location of current upper pipe 

c 

YL 

REALM 

y location of current lower pipe 

c 

XMIN 

REALM 

minimum x value of piping layout 

c 

XMAX 

REALM 

maximum x value of piping layout 

c 

YMIN 

REALM 

minimum y value of piping layout 

c 

YMAX 

REALM 

maximum y value of piping layout 

c 

SINA 

REALM 

sine of current pipe direction 

c 

p 

COSA 

REALM 

cosine of current pipe direction 

c 



/RELVAL/ 

c 

A 

REALM 

speed of sound in the fluid (ft/sec) 

c 

AREA(75) 

REALM 

area of pipe section (ft~2) 

c 

AREAB 

REALM 

area of current pipe section (ft~2) 

c 

OMAN 

REALM 

manifold capacitance 

c 

CTANK 

REALM 

tank capacitance 

c 

DENS 

REALM 

density of fluid (lbm/ft~3) 

c 

DIA(75) 

REALM 

diameter of pipe section (ft) 

c 

DIME 

REALM 

diameter of current pipe section (ft) 

c 

DPROR 

REALM 

pressure drop across orfices (lbf/ft~2) 

c 

1(75) 

REALM 

length of pipe section (ft) 

c 

PCHMB 

REALM 

chamber pressure (lbf/ft~2) 

c 

PIPE1(75) 

REALM 

first parameter of pipe description 

c 

PIPE2(75) 

REALM 

second parameter of pipe description 

c 

PIPE3(75) 

REALM 

third parameter of pipe description 

c 

PIPE4(75) 

REALM 

fourth parameter of pipe description 

c 

PIPE5(75) 

REALM 

fifth parameter of pipe description 

c 

TFLOW 

REALM 

total flow rate of engine (lbm/sec) 

c 

VALUE 

REALM 

used for passing different values 

c 

VOL 

REALM 

volume of tank (ft~3) 

c 

VOLMF 

REALM 

volume of manifold (ft~3) 

c 

PMRAT 

REALM 

chamber pressure/total mass flow 

c 

SPLIT 

REALM 

number of lines from pipe split 

c 

PCAP(75) 

REALM 

capacitance of pipe section 

c 

PIND(75) 

REALM 

inductance of pipe section 

c 

KMAN 

REALM 

bulk modulus of manifold (lbf/ft~2) 

c 

KTANK 

REALM 

bulk modulus of tank (lbf/ft~2) 

c 

p 

LFLOW 

REALM 

flow rate through pipe (lbm/sec) 

c 



/WCAOUT 

c 

NAMLIN 

CHAR*24 

name of file containing pipe description 
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c 

p 

IFRST 

INTEGERS 

flag for admittance plot 

c 


/ WCATIT/ 

c 

TITLE 

CHARMO 

title for plots 

c 

TITLF 

CHAR*20 

title from pipe file 

c 

IHR 

INTEGERS 

hour code run 

c 

IMIN 

INTEGERS 

minute code run 

c 

AP 

CHAR*2 

AM or PM 

c 

IYR 

INTEGER*2 

yesr code run 

c 

I MON 

INTEGER*2 

month code run 

c 

c 

I DAY 

INTEGER*2 

day code run 

c 

c 

PROGRAM ACCUM 



c 

r 

Determines maximum array sizes 

c 

Local Variables 

c 

I 

INTEGERM 

do loop index 

c 

I ERR 

INTEGER*2 

error flag for ALLOCATE 

c 

IXMAX 

INTEGERS 

maximum number of frequencies 

c 

IYMAX 

INTEGERM 

maximum number of points along i 

c 

X( IXMAX, IYMAX) 

REALM 

frequency array for plotting 

c 

XF( IXMAX) 

REALM 

frequency array 

c 

Y( IXMAX, IYMAX) 

REALM 

location array for plotting 

c 

YF( IYMAX) 

REALM 

location array 

c 

Z( IXMAX, IYMAX) 

REALM 

gain array for plotting 

c 

c 

ZFCIXMAX, IYMAX) 

REALM 

gain array 

c 

c 

SUBROUTINE MAINP(X ,Y , Z , XF , YF, ZF, IXMAX, IYMAX) 

c 

r 

Logic portion of code 


c 

Commons FACTOR 

FREQ INTVAL RELVAL WCAOUT WCATIT 

c 


Variables in Argument List 

c 

IXMAX 

INTEGERM 

maximum number of frequencies 

c 

IYMAX 

INTEGERM 

maximum number of points along | 

c 

X( IXMAX, IYMAX) 

REALM 

frequency array for plotting 

c 

XF( IXMAX) 

REALM 

frequency array 

c 

Y( IXMAX, IYMAX) 

REALM 

location array for plotting 

c 

YF( IYMAX) 

REALM 

location array 

c 

Z( IXMAX, IYMAX) 

REALM 

gain array for plotting 

c 

ZFCIXMAX, IYMAX) 

REALM 

gain array 

c 


Local Variables 

c 

ADMMAX 

REALM 

maximum value of admittance for 

c 

AM 

CHAR*2 

’AM’ 

c 

ANS 

CHAR*1 

response to question 

c 

AVGK 

REALM 

average bulk modulus (lbf/ft''2) 

c 

CAPM 

C0MPLEX*8 

intermediate variable 

c 

CAPN 

C0MPLEX*8 

intermediate variable 

c 

CFAC 

COMPLEX*8 

intermediate variable 
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c 

ERRP 

REALM 

error in gain calculation 

c 

G ( 0 : 76 ) 

COMPLEX*8 

admittance looking toward tank 

c 

GRAV 

REALM 

gravitational constant (lbm-ft/lbf-sec"2) 

c 

G1 

COMPLEX*8 

admittance starting at G(0)+1 

c 

HFREQ 

REALM 

maximum frequency requested 

c 

I 

INTEGERS 

do loop index 

c 

IOPEN 

INTEGERS 

flag indicating if SURF. ERR is open 

c 

IPLT 

INTEGERS 

flag indicating when admittance is plotted 

c 

ISEC 

INTEGERS 

second code run 

c 

ISIZ 

INTEGERS 

counter for number of integration segments 

c 

1100 

INTEGERS 

hundredth of second code run 

c 

K 

INTEGERS 

do loop index 

c 

KLOOP 

INTEGER*2 

do loop index 

c 

LFREQ 

REALM 

minimum frequency requested 

c 

MAG 

REALM 

magnitude of G at orfice 

c 

MAGI 

REALM 

magnitude of G1 at orfice 

c 

NAMFUL 

CHAR*24 

name of fuel file (if used) 

c 

NAMLOX 

CHAR*24 

name of lox file (if used) 

c 

PI 

REALM 

mathematical constant 

c 

PM 

CHAR*2 

’PM’ 

c 

PTS 

INTEGER*2 

number of frequencies 

c 

RHS 

COMPLEX*8 

intermediate variable 

c 

RSPON 

INTEGER*2 

flag to MODIFY subroutine 

c 

SSIZE 

REALM 

frequency step size 

c 

TL 

REALM 

length/speed of sound 

c 

TLT 

REALM 

total lenthe of piping 

c 

W 

REALM 

oscillatory part of frequency 

c 

WN 

REALM 

normalized W 

c 

WVAL 

REALM 

maximum gain 

c 

ZGEFF 

COMPLEX*8 

effective impedance for calculations 

c 

ZOEFF 

C0MPLEX*8 

effective ZO for calculations 

c 

ZOR 

REALM 

intermediate variable 

c 

c 

ZTOP 

REALM 

intermediate variable 

c 

c 

SUBROUTINE ADMGRAPH( LFREQ, HFREQ, ADMMAX) 

c 

p 

Plots 

admittance curve 


c 

Commons FACTOR NOCOL WCATIT 

c 


Variables 

in Argument List 

c 

ADMMAX 

REALM 

maximum value of admittance for plot 

c 

HFREQ 

REALM 

maximum frequency requested 

c 

LFREQ 

REALM 

minimum frequency requested 

c 


Local Variables 

c 

XMAJ 

REALM 

distance between tick marks on x axis 

c 

XMAX 

REALM 

maximum value of x 

c 

XMIN 

REALM 

mimimum value of x 

c 

YMAJ 

REALM 

distance between tick marks on y axis 

c 

YMAX 

REALM 

maximum value of y 

c 

YMIN 

REALM 

mimimum value of y 


c 

c 
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C SUBROUTINE ALLPT (X , Y , PTS ) 

C Supervises plot of admittance after calculations 

C 
C 

C PTS 
C X(PTS) 

C Y(PTS) 

C 

C ADMMAX 
C I 
C 
C 

C SUBROUTINE BENDS(PIPE1 ,PIPE2,PIPE3,PIPE4, VALUE, DIME) 

C Computes effective straight pipe for bend 

C 
C 

C DIME 
C PIPE1 
C PIPE2 
C PIPE3 
C PIPE4 
C VALUE 
C 

C AREAB 
C ARBND 
C BENDR 
C GAMMA 
C INERT 
C INRAD 
C LBND 
C LPRME 
C NEWLN 
C OTRAD 
C RATIO 
C X 
C Y 
C 
C 

SUBROUTINE BNSECT ( J , ITYPE , POINT , PIPE1 , PIPE2 , PIPE3 , PIPE4 ) 

Computes plot coordinates for a bend 

Commons ARCCON PIPPXY 
C Variables in Argument List 

C ITYPEC200) INTEGERS type plot element 

C J INTEGER*2 pointer to element 

C PIPE1 REALM first parameter of pipe description 

C PIPE2 REAL*4 second parameter of pipe description 

C PIPE3 REALM third parameter of pipe description 

C PIPE4 REALM fourth parameter of pipe description 

C POINT (8 , 200) REALM description of plot element 

C Local Variables 

C DIA REALM intermediate variable 


Variables in Argument List 
REALM effective diameter (ft) 

REALM radius of bend (ft) 

REALM angle of bend (degrees) 

REALM diameter of bend (ft) 

REALM length of end straight segments (ft) 

REALM effective length (ft) 

Local Variables 

REALM effective area of bend 

REALM area of bend 

REALM bend angle in radians 

REALM intermediate variable 

REALM intermediate variable 

REALM inside radius of bend 

REALM intermediate variable 

REALM intermediate variable 

REALM intermediate variable 

REALM outside radius of bend 

REALM intermediate variable 

REALM intermediate variable 

REALM intermediate variable 


Variables in Argument List 
INTEGER*2 number of frequencies 
REALM frequency array 
REALM admittance array 
Local Variables 

REALM maximum value of admittance for plot 
INTEGER*2 do loop index 
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c 

HOLD 


REAL*4 

intermediate variable 


c 

RANG 


REALM 

intermediate variable 


c 

SLENTH 


REALM 

intermediate variable 


c 

XO 


REALM 

intermediate variable 


c 

XI 


REALM 

intermediate variable 


c 

X2 


REALM 

intermediate variable 


c 

X3 


REALM 

intermediate variable 


c 

YO 


REALM 

intermediate variable 


c 

Y1 


REALM 

intermediate variable 


c 

Y2 


REALM 

intermediate variable 


c 

c 

Y3 


REALM 

intermediate variable 


c 

c 

COMPLEX 

FUNCTION CCOSH(S) 



c 

p 

Evaluates 

the complex 

hyperbolic cosine 


c 



Variables 

in Argument List 


c 

S 


COMPLEX*8 

complex frequency 


c 



Local Variables 


c 

COSH I 


REALM 

intermediate variable 


c 

COSHR 


REALM 

intermediate variable 


c 

LAMDA 


REALM 

real part of complex frequency 

c 

c 

MU 


REALM 

imaginary part of complex 

frequency 

c 

c 

COMPLEX 

FUNCTION CSINH(S) 



c 

p 

Evaluates 

the complex 

hyperbolic sine 


c 



Variables 

in Argument List 


c 

S 


COMPLEX*8 

complex frequency 


c 



Local Variables 


c 

LAMDA 


REALM 

intermediate variable 


c 

MU 


REALM 

intermediate variable 


c 

SINHI 


REALM 

real part of complex frequency 

c 

c 

SINHR 


REALM 

imaginary part of complex 

frequency 

c 

c 

COMPLEX 

FUNCTION CTANH(S) 



c 

p 

Evaluates 

the complex 

hyperbolic tangent 


c 



Variables 

in Argument List 


c 

c 

S 


COMPLEXES 

complex frequency 


c 

c 

SUBROUTINE ENDPLT 



c 

p 

Closes plot routines 



c 

Commons 

NOCOL 

WCAPAS 



c 



Local Variables 


c 

IEXTEN 


INTEGER*? 

extension of key hit 


c 

I KEY 


INTEGER*? 

code of key hit 



c 
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c 

C SUBROUTINE FREQRS(YF, ZF, K, IXMAX , IYMAX, KLOOP , ERRP , WVAL ) 
C Computes pressure transfer function 

C 

C Commons FREQ INTVAL RELVAL 


c 


Variables in Argument List 

c 

ERRP 

REALM 

error in gain calculation 

c 

IXMAX 

INTEGERM 

maximum number of frequencies 

c 

IYMAX 

INTEGERM 

maximum number of points along pip 

c 

K 

INTEGERS 

frequency pointer 

c 

KLOOP 

INTEGERS 

loop pointer 

c 

WVAL 

REALM 

maximum gain 

c 

YF( IYMAX) 

REALM 

location array 

c 

ZF( IXMAX, IYMAX) 

REALM 

gain array 

c 


Local Variables 

c 

BOTTOM 

COMPLEX*8 

intermediate variable 

c 

CAPM 

C0MPLEX*8 

intermediate variable 

c 

CAPN 

COMPLEX*8 

intermediate variable 

c 

DX 

REALM 

x increment 

c 

ERRN 

REALM 

local error 

c 

I 

INTEGERS 

do loop index 

c 

J 

INTEGERS 

do loop index 

c 

LITTLN 

COMPLEX*8 

intermediate variable 

c 

LSEC 

INTEGERS 

number of segments of pipe section 

c 

M 

INTEGERS 

locatioon pointer 

c 

PRAT 

C0MPLEX*8 

pressure ratio 

c 

PRATN 

REALM 

absolute value of pressure ratio 

c 

PRATO(2 , 75) 

REALM 

previous pressure ratio 

c 

SUMX 

REALM 

distance from orfice 

c 

TOP 

C0MPLEX*8 

intermediate variable 

c 

X 

REALM 

distance along pipe section 

c 

c 

ZFAC 

C0MPLEX*8 

intermediate variable 

c 

c 

SUBROUTINE GINERT(BEND,X, Y) 

c 

p 

Evaluates curve fit of 

inertance of bends 

c 


Variables 

in Argument List 

c 

BEND 

REALM 

angle of bend (degrees) 

c 

X 

REALM 

ratio of inner to outer radius 

c 

Y 

REALM 

inertance 

c 


Local Variables 

c 

A 

REALM 

intermediate variable 

c 

c 

B ( 3 ) 

REALM 

coefficient array for inertance fi 

c 

c 

SUBROUTINE HHSECT( J , ITYPE, POINT, LEN.DIA, VOL) 

c 

p 

Computes plot coordinates for Helmholtz resonator 

c 

Common PIPPXY 



c 


Variables 

in Argument List 

c 

DIA 

REALM 

diameter of opening (ft) 
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c 

ITYPE( 200) 

INTEGER*2 

type plot element 

c 

J 

INTEGERS 

pointer to element 

c 

LEN 

REALM 

length of opening (ft) 

c 

POINT (8 , 200 ) 

REALM 

description of plot element 

c 

VOL 

REALM 

volume of reservoir (ft~3) 

c 


Local Variables 

c 

COSOLD 

REALM 

intermediate variable 

c 

DIAM 

REALM 

intermediate variable 

c 

SIDE 

REALM 

intermediate variable 

c 

SINOLD 

REALM 

intermediate variable 

c 

XC 

REALM 

intermediate variable 

c 

XHOLD 

REALM 

intermediate variable 

c 

XLOLD 

REALM 

intermediate variable 

c 

XOLD 

REALM 

intermediate variable 

c 

YC 

REALM 

intermediate variable 

c 

YHOLD 

REALM 

intermediate variable 

c 

YLOLD 

REALM 

intermediate variable 

c 

c 

YOLD 

REALM 

intermediate variable 

c 

c 

SUBROUT I N E LOWERW ( L FREQ , H FR EQ , ADMMAX ) 

c 

c 

Sets up lower plotting 

window 

c 

Commons ADMCOL 

NOCOL 


c 


Variables 

in Argument List 

c 

ADMMAX 

REALM 

maximum value of admittance for plot 

c 

HFREQ 

REALM 

maximum frequency requested 

c 

LFREQ 

REALM 

minimum frequency requested 

c 


Local Variables 

c 

ASPECT 

REALM 

aspect ratio of monitor screen 

c 

IOPT 

INTEGERS 

intermediate variable 

c 

JCOL1 

INTEGERS 

starting column for admittance window 

c 

JCOL2 

INTEGERS 

ending column for afdmittance window 

c 

JROW1 

INTEGERS 

starting row for admittance window 

c 

JROW2 

INTEGERS 

ending row for admittance window 

c 

XLEN 

REALM 

intermediate variable 

c 

XMAX 

REALM 

maximum x value for admittance plot 

c 

XMIN 

REALM 

minimum x value for admittance plot 

c 

XORG 

REALM 

x origin for admittance plot 

c 

YLEN 

REALM 

intermediate variable 

c 

YMAX 

REALM 

maximum y value for admittance plot 

c 

YMIN 

REALM 

minimum y value for admittance plot 

c 

YOVERX 

REALM 

intermediate variable 

c 

YORG 

REALM 

y origin for admittance plot 


c 

c 

C SUBROUTINE MODIFY(RSPON ) 

C Allows modifications to input data 

C 

C Commons INTVAL RELVAL WCAOUT WCATIT 

C Variables in Argument List 

C RSPON INTEGERS flag for path to be taken 
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C Local Variables 


c 

ANS 

CHAR*1 

response to question 

c 

AVGK 

REALM 

average bulk modulus (lbf/ft''2) 

c 

GRAV 

REALM 

gravitational constant ( lbm-ft/lbf-sec~2) 

c 

I 

INTEGER*2 

pointer 

c 

II 

INTEGER*2 

do loop index 

c 

III 

INTEGER*2 

do loop index 

c 

ICHG 

INTEGERS 

change flag 

c 

I SEGMN 

INTEGER*2 

intermediate variable 

c 

NAME 

CHARM 

variable name 

c 

PI 

REALM 

mathematical constant 

c 

VARL(9) 

CHARM 

array of variable names (lower case) 

c 

VARU(9) 

CHARM 

array of variable names (upper case) 

c 

c 

VARVAL(9) 

CHARM 

array of variable names for printout 

c 

c 

SUBROUTINE NEXPT(WN.MAGl) 


c 

p 

Supervises 

plot of admittance while computing 

c 

c 

Common WCAPAS 

Variables 

in Argument List 

c 

MAGI 

REALM 

admittance 

c 

WN 

REALM 

frequency 

c 


Local Variables 

c 

X ( 2 ) 

REALM 

print line (frequency) 

c 

Y(2) 

REALM 

print line (admittance) 


C 

C 

C SUBROUTINE PIPPLOT (SEGMN ,SECTN , PIPE1 , PIPE2 , PIPE3 , PIPE4) 
C Supervises plot of piping layout 

C 


C 

Commons ARCCON 

PIPPXY 


c 


Variables 

in Argument List 

c 

PIPE1(75) 

REALM 

first parameter of pipe description 

c 

PIPE2 ( 75 ) 

REALM 

second parameter of pipe description 

c 

PIPE3(75) 

REALM 

third parameter of pipe description 

c 

PIPE4(75) 

REALM 

fourth parameter of pipe description 

c 

SECTN(75) 

INTEGERS 

segment types 

c 

SEGMN 

INTEGERS 

number of pipe segments 

c 


Local Variables 

c 

I 

INTEGERS 

do loop index 

c 

ITYPE(200) 

INTEGERS 

type plot element 

c 

J 

INTEGERM 

pointer to element 

c 

POINT (8, 200) 

REALM 

description of plot element 

c 

XP(2) 

REALM 

x plot array 

c 

XRANGE 

REALM 

range of x values 

c 

XO 

REALM 

intermediate variable 

c 

XI 

REALM 

intermediate variable 

c 

X2 

REALM 

intermediate variable 

c 

X3 

REALM 

intermediate variable 

c 

YP(2) 

REALM 

y plot array 

c 

YRANGE 

REALM 

range of y values 
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c 

VO 

REALM 

intermediate variable 

c 

Y1 

REALM 

intermediate variable 

c 

Y2 

REALM 

intermediate variable 

c 

c 

Y3 

REALM 

intermediate variable 

c 

c 

SUBROUTINE PLOTSU ( X , Y , Z , XF , YF , ZF , JPTS , IPTS , IXMAX , IYMAX ) 

c 

p 

Supervises 

the surface 

plot 

c 

Commons FACTOR 

WCATIT 


c 


Variables in Argument List 

c 

IPTS 

INTEGERS 

actual number of frequencies 

c 

IXMAX 

INTEGERM 

maximum number of frequencies 

c 

IYMAX 

INTEGERM 

maximum number of points along piping 

c 

JPTS 

INTEGERS 

actual number of points along pipe 

c 

X( IPTS , JPTS) 

REALM 

frequency array for plotting 

c 

XF( IXMAX) 

REALM 

frequency array 

c 

Y(IPTS, JPTS) 

REALM 

location array for plotting 

c 

YF( IYMAX) 

REALM 

location array 

c 

Z(IPTS, JPTS) 

REALM 

gain array for plotting 

c 

ZF(IXMAX, IYMAX) 

REALM 

gain array 

c 


Local Variables 

c 

ANS 

CHAR*1 

response to question 

c 

ASPECT 

REALM 

aspect ratio of monitor 

c 

I 

INTEGERS 

do loop index 

c 

I BOARD 

INTEGERS 

type graphics board installed 

c 

ICOLR 

INTEGERS 

background color 

c 

IEXTEN 

INTEGERS 

extension of key hit 

c 

IFIL 

INTEGER*2 

fill color 

c 

I GO 

INTEGER*2 

flag for changes 

c 

I KEY 

INTEGERS 

code of key hit 

c 

ILIN 

INTEGER*2 

line color 

c 

IWIRE 

INTEGER*2 

flag for wire-frame or filled 

c 

IWR 

INTEGER*2 

temporary flag for wire-frame or filled 

c 

IWRK1 ( 640 ) 

INTEGER*2 

work array for plot routine 

c 

IWRK2(640) 

INTEGERS 

work array for plot routine 

c 

J 

INTEGER*2 

do loop index 

c 

LEGEND 

CHARM5 

legend for CGA monitor 

c 

LEGENDH 

CHAR*58 

legend for EGA or VGA monitor (Hertz) 

c 

LEGENDR 

CHAR* 58 

legend for EGA or VGA monitor (rad/sec) 

c 

MODE 

INTEGERS 

graphics mode 

c 

MODET 

INTEGER*2 

text mode 

c 

NCOLT 

INTEGER*2 

number of columns in text mode 

c 

P 

REALM 

phi rotation angle (degrees) 

c 

T 

REALM 

theta rotation angle (degrees) 

c 

XFAC 

REALM 

intermediate variable 

c 

XINV 

REALM 

intermediate variable 

c 

XLEN 

REALM 

length of x axis 

c 

XMAJ 

REALM 

distance between tick marks on x axis 

c 

XMAX 

REALM 

maximum value for x axis 

c 

XMIN 

REALM 

minimum value for x axis 

c 

XYZLEN 

REALM 

intermediate variable 
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c 

YFAC 

REALM 

intermediate variable 

c 

YINV 

REALM 

intermediate variable 

c 

YLEN 

REALM 

length of y axis 

c 

YMAJ 

REALM 

distance between tick marks on y axis 

c 

YMAX 

REALM 

maximum value for y axis 

c 

YMIN 

REALM 

minimum value for y axis 

c 

ZFAC 

REALM 

intermediate variable 

c 

ZINV 

REALM 

intermediate variable 

c 

ZLEN 

REALM 

length of z axis 

c 

ZMAJ 

REALM 

distance between tick marks on z axis 

c 

ZMAX 

REALM 

maximum value for z axis 

c 

c 

ZMIN 

REALM 

minimum value for z axis 

c 

c 

SUBROUTINE PLSECT ( J , ITYPE , POINT , LEN , DIA , VOL ) 

c 

p 

Computes 

plot coordinates for parallel resonator 

c 

Commons ARCCON PIPPXY 


c 


Variables 

in Argument List 

c 

DIA 

REALM 

diameter of parallel segment (ft) 

c 

ITYPE(200) 

INTEGERS 

type plot element 

c 

J 

INTEGERS 

pointer to element 

c 

LEN 

REALM 

length of parallel segment (ft) 

c 

POINT (8 , 200 ) 

REALM 

description of plot element 

c 

VOL 

REALM 

volume of bypassed segment (ft"3) 

c 


Local Variables 

c 

ANGOLD 

REALM 

intermediate variable 

c 

ANGSAV 

REALM 

intermediate variable 

c 

COSOLD 

REALM 

intermediate variable 

c 

DIAM 

REALM 

intermediate variable 

c 

PDIA 

REALM 

intermediate variable 

c 

PLEN 

REALM 

intermediate variable 

c 

RADIUS 

REALM 

intermediate variable 

c 

SIDE 

REALM 

intermediate variable 

c 

SINOLD 

REALM 

intermediate variable 

c 

TURN 

REALM 

intermediate variable 

c 

XHC 

REALM 

intermediate variable 

c 

XHOLD 

REALM 

intermediate variable 

c 

XHSAV 

REALM 

intermediate variable 

c 

XLC 

REALM 

intermediate variable 

c 

XLOLD 

REALM 

intermediate variable 

c 

XLSAV 

REALM 

intermediate variable 

c 

XOLD 

REALM 

intermediate variable 

c 

XSAV 

REALM 

intermediate variable 

c 

YHC 

REALM 

intermediate variable 

c 

YHOLD 

REALM 

intermediate variable 

c 

YHSAV 

REALM 

intermediate variable 

c 

YLC 

REALM 

intermediate variable 

c 

YLOLD 

REALM 

intermediate variable 

c 

YLSAV 

REALM 

intermediate variable 

c 

YOLD 

REALM 

intermediate variable 

c 

YSAV 

REALM 

intermediate variable 
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c 

c 

C SUBROUTINE PLTCON ( X , Y , Z , XF , YF , ZF , JPTS , IPTS , IXMAX , IYMAX ) 
C Supervises plot of contour plot 


C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


Commons FACTOR 

IPTS 

IXMAX 

IYMAX 

JPTS 

X(IPTS) 

XF( IXMAX) 
Y(JPTS) 

YF( IYMAX) 
Z(IPTS, JPTS) 

ZF( IXMAX, IYMAX) 

ANS 

ASPECT 

CONS(IO) 

I 

I BOARD 

ICOLR 

IDEF 

IEXTEN 

IFIL 

I KEY 

ILIN 

IOPT 

J 

JCOL1 

JCOL2 

JROW1 

JROW2 

LABL(IO) 

MODE 

MODET 

NCOLT 

XMAJ 

XMAX 

XMIN 

XORG 

YMAJ 

YMAX 

YMIN 

YORG 

YOVERX 

ZLEN 

ZMAX 

ZMIN 


WCATIT 

Variables in Argument List 
INTEGER*2 actual number of frequencies 
INTEGERM maximum number of frequencies 
INTEGERM maximum number of points along piping 
INTEGERS actual number of points along pipe 
REAL*4 frequency array for plotting 
REALM frequency array 
REALM location array for plotting 
REALM location array 
REALM gain array for plotting 
REALM gain array 
Local Variables 

REALM response to question 

REALM aspect ratio of monitor 

REALM array for values of contour lines 

INTEGER*2 do loop index 

INTEGER*2 type graphics board installed 

INTEGER*2 background color 

INTEGER*2 flag for plot routine 

INTEGERS extension of key hit 

INTEGERS fill color 

INTEGER*2 code of key hit 

INTEGER*2 line color 

INTEGER*2 flag for plot routine 

INTEGER*2 do loop index 

INTEGER*2 starting column for contour plot window 
INTEGER*2 ending column for contour plot window 
INTEGER*2 starting row for contour plot window 
INTEGER*2 ending row for contour plot window 
INTEGER*2 flags for labeling contours 
INTEGERS graphics mode 
INTEGER*2 text mode 

INTEGER*2 number of columns in text mode 
REALM distance between tick marks on x axis 
REALM maximum value for x axis 
REALM minimum value for x axis 
REALM origin of x axis 

REALM distance between tick marks on y axis 

REALM maximum value for y axis 

REALM minimum value for y axis 

REALM origin of y axis 

REALM intermediate variable 

REALM intermediate variable 

REALM maximum value for z 

REALM minimum value for z 
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c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


SUBROUTINE SETPLT 

Sets up the plot environment 


Commons ADMCOL 
ANS 

I BOARD 

ITIM 

NCOLT 


NOCOL WCAPAS 


Local Variables 


CHARM 

INTEGERS 

INTEGERS 

INTEGERS 


response to question 
type graphics board installed 
flag for initialization 
number of columns in text mode 


SUBROUTINE STSECT(J , ITYPE, POINT, LEN, DIA) 

Computes plot coordinates for a straight section 


Common PIPPXY 
DIA 

ITYPE(200) 

J 

LEN 

POINT (8, 200) 


Variables 

REAL*4 

INTEGERS 

INTEGERS 

REALM 

REALM 


in Argument List 
diameter of segment (ft) 
type plot element 
pointer to element 
length of segment (ft) 
description of plot element 


SUBROUTINE TSSECT ( J , ITYPE , POINT , LEN , DIA) 

Computes plot coordinates for a tuned stub 


Common PIPPXY 
DIA 

ITYPE(200) 

J 

LEN 

POINT ( 8 , 200) 
DIAM 


Variables in Argument List 
REALM diameter of tuned stub (ft) 
INTEGERS type plot element 
INTEGER*2 pointer to element 
REALM length of tuned stub 
REALM description of plot element 
Local Variables 

REALM intermediate variable 


SUBROUTINE UPPERW(X0,Y0,X1, Yl) 
Sets up upper plotting window 


Commons ADMCOL 

X0 

XI 

Y0 

Yl 


ASPECT 

CHANGE 

IOPT 

JC0L1 


NOCOL 

Variables in Argument List 
REALM minimum value of x for piping layout 

REALM maximum value of x for piping layout 

REALM minimum value of y for piping layout 

REALM maximum value of y for piping layout 

Local Variables 

REALM aspect ratio of monitor 

REALM intermediate variable 

INTEGER*2 flag for plot routine 

INTEGER*2 starting column for pipe layout plot 


window 

window 

window 

window 


window 
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o o o 


c 

JC0L2 

INTEGERS 

ending column for pipe layout plot window 

c 

JR0W1 

INTEGERS 

starting row for pipe layout plot window 

c 

JR0W2 

INTEGERS 

ending row for pipe layout plot window 

c 

XMAX 

REALM 

maximum value for x axis 

c 

XMIN 

REALM 

minimum value for x axis 

c 

XORG 

REALM 

origin of x axis 

c 

YMAX 

REALM 

maximum value for x axis 

c 

YMAXO 

REALM 

intermediate variable 

c 

YMIN 

REALM 

minimum value for x axis 

c 

YORG 

REALM 

origin of x axis 

c 

YOVERX 

REALM 

intermediate variable 


c 

c 


SUBROUTINE WINDOW(MODE ,XSCALE,XST ,XFIN, YST , YFIN , ZST , ZFIN ) 
Sets up window for surface plot 


C 


Variables 

in Argument List 

C 

MODE 

INTEGERS 

graphics mode 

c 

XFIN 

REALM 

final x value 

c 

XSCALE 

REALM 

aspect ratio of monitor 

c 

XST 

REALM 

starting x value 

c 

YFIN 

REALM 

final y value 

c 

YST 

REALM 

starting y value 

c 

ZFIN 

REALM 

final z value 

c 

ZST 

REALM 

starting z value 

c 


Local Variables 

c 

ASPECT 

REALM 

aspect ratio of monitor 

c 

IOPT 

INTEGERS 

flag for plot routine 

c 

JC0L1 

INTEGERS 

starting column for surface plot window 

c 

JC0L2 

INTEGERS 

ending column for surface plot window 

c 

JR0W1 

INTEGERS 

starting row for surface plot window 

c 

JR0W2 

INTEGERS 

ending row for surface plot window 

c 

XMAX 

REALM 

maximum value for x axis 

c 

XMIN 

REALM 

minimum value for x axis 

c 

XORG 

REALM 

origin of x axis 

c 

YMAX 

REALM 

maximum value for y axis 

c 

YMIN 

REALM 

minimum value for y axis 

c 

YORG 

REALM 

origin of y axis 

c 

YOVERX 

REALM 

intermediate variable 


C 

C 

C FUNCTION XFUN(T) 

C Parametric function for plotting of bends 

C 

C Common ARCCON 

C Variables in Argument List 

C T REAL*4 angle in radians 

C 
C 

C FUNCTION YFUN(T) 

C Parametric function for plotting of bends 

C 
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c 

Common ARCCON 



c 


Variables 

in Argument List 

c 

c 

T 

REAL*4 

angle in radians 

c 

c 

SUBROUTINE ZREAD(NAME, VALUE) 

c 

c 

Reads input 

for input i 

modification 

c 


Variables 

in Argument List 

c 

NAME(8) 

CHAR*1 

name of input variable 

c 

VALUE 

REAL*4 

value of input variable 

c 


Local Variables 

c 

BLK 

CHAR*1 

J 1 

c 

CARD(80 ) 

CHAR*1 

card image 

c 

CENDC3) 

CHAR*1 

’E’ , ’N VD’ 

c 

COMMA 

CHAR*1 

1 J 

> 

c 

CTIT (5 ) 

CHAR*1 

’TVr , ’T’, ’L’ , ’E’ 

c 

DCARD 

CHAR*80 

card image 

c 

E 

CHAR*1 

’E* 

c 

FRACT 

REAL*4 

fractional part of number 

c 

I 

INTEGER*2 

do loop index 

c 

ICOUNT 

INTEGER*2 

position counter 

c 

ID 

INTEGER*2 

position counter 

c 

II 

INTEGER*2 

position counter 

c 

J 

INTEGER*2 

do loop index 

c 

JJ 

INTEGER*2 

position counter 

c 

LE 

CHAR*1 

’e’ 

c 

LEND(3) 

CHAR*1 

’e’ , ’n’ , ’d’ 

c 

LTIT (5 ) 

CHAR*1 

J 4- > f f 1 11) )_) 

t , i , t , 1 , e 

c 

MINUS 

CHAR*1 

) _ ) 

c 

NUMBER(IO) 

CHAR*1 

’0’ , ’1’ , ’2’ , ’3’ , ’4’ , ’5’ , ’6 

c 

PERIOD 

CHAR*1 

) 1 

c 

PLUS 

CHAR*1 


c 

POUND 

CHAR*1 

’4’ 

c 

QUEST 

CHAR»1 

’ ? ’ 

c 

SIGN 

REAL*4 

sign of number or exponent 

c 

WHOLE 

REAL*4 

WHOLE PART OF NUMBER 


c 


’8’ , ’9’ 


INTERFACE TO SUBROUTINE 

1 c1earscreen[FAR, C, ALIAS: " clearscreen '"] (area) 

INTEGER*2 area 
END 

INTEGERS IXMAX,IYMAX, I 

REAL X[ALLOCATABLE] ( : , : ) , Y[ALLOCATABLE] ( : , : ) ,Z[ALLOCATABLE] 

* XF[ALLOCATABLE] ( : ) , YF[ALLOCATABLE] ( : ) , ZF[ALLOCATABLE] ( : , : ) 
EXTERNAL CLEARSCREEN 
DO 20 1=150,1,-1 
IXMAX=I 
IYMAX=I 
IERR=0 

ALLOCAT E (X ( IXMAX , IYMAX ) , Y ( IXMAX , IYMAX ) , Z ( IXMAX , IYHAX ) , STAT= I ERR ) 
ALLOCATE(XF( IXMAX) , YF( IYMAX) , ZF( IXMAX, IYMAX) ,STAT=IERR) 
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IF(IERR.EQ.O) GO TO 21 

DEALLOCAT E(X,Y,Z,XF,YF,ZF,STAT=I ERR ) 

20 CONTINUE 
STOP 

21 CONTINUE 

CALL CLEARSCREEN(O) 

WRITEC*, ’ (10X,A) ’ ) 

WRITEC*, ’ (10X,A) ’ ) " 

*’l i 

write (*, (iox,a) ’ ) 

*’|| Welcome to ACCUM - a Feedline Analysis Program II 

WRITEC* , ’ ( 10X, A) ’ ) 

*’ | I) 

WRITEC*, ’ ( 10X , A ) ’ ) 

*’f To send a plot to the printer || 

WRITEC*, ’(10X, A)’) 

*1 II 

WRITE(*, ’ (10X,A) ’ ) 

The computer MUST be in GRAPHICS mode | 

WRITEC*,' (10X, A)’) 

*’| II 

WRITEC*, '(10X, A)’) 

*'| Hit PrScn to send the current plot to the printer H 

WRITEC*, '(10X, A)’) 

*’! « 

WRITEC*, ’ ( 10X, A)’) 

*’ M 

WRITEC*,*)’ ’ 

WRITEC* ,’ C20X, A, 14) ’) ’Maximum no. of frequencies = ’,IXMAX 
WRITEC* ,’ (20X, A, 14) ’) ’Maximum points along pipe = ’,IYMAX 
WRITEC*,*)’ ’ 

CALL MAINPCX,Y,Z,XF,YF,ZF, IXMAX, IYMAX) 

STOP 

END 

SUBROUT INE MAINP(X,Y,Z,XF,YF,ZF, IXMAX , IYMAX ) 

C Logic portion of code 

INTEGER*4 IXMAX, IYMAX 

COMPLEX G ( 0 : 76) ,CTANH,G1 ,S,ZT(0:76),ZGC76) ,RHS, CFAC , CAPN , CAPM 
COMPLEX ZGEFF.ZOEFF 

REAL AREA(75),DIA(75),L(75),PIPE1C75),PIPE2(75),PIPE3(75), 

* PIPE4C75) , PIPE5C75) ,ZO(76) , PCAPC75) ,PIND(75) 

REAL KMAN , KTANK, LFLOW , LFREQ, MAG , MAGI 

REAL X( IXMAX, IYMAX) ,Y( IXMAX, IYMAX ) ,Z( IXMAX, IYMAX) 

REAL XF( IXMAX) , YF( IYMAX) , ZF( IXMAX, IYMAX) 

INTEGER*2 SECTN ( 7 5 ) , PTS , RSPON , SECT , SEGMN 
CHARACTER ANS*1 

CHARACTER* 2 4 NAMLIN , NAMFUL , NAMLOX 
COMMON /WCAOUT/NAMLIN 

COMMON /RELVAL/A , AREA , AREAB , CMAN , CTANK , DENS , DI A , DIME , DPROR , KMAN , 

* KTANK , L , LFLOW , PCHMB, PIPE1 , PIPE2 , PIPE3 , PIPE4 , PIPE5 , 

* T FLOW , VALUE , VOL , VOLMF , PMRAT , SPLIT , PCAP , PI ND 
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COMMON /INTVAL/SECT , SECTN , SEGMN , NSEC( 7S ) , NPTS , LOPEND , LOPOLD 
COMMON /FREQ/S, ZT,ZG,ZO 

INTEGER*2 I HR, IMIN, ISEC, 1100, IYR, IMON,IDAY 
CHARACTER*2 AM,PM,AP 
CHARACTER*40 TITLE 
CHARACTER* 20 TITLF 

COMMON /WCATIT/TITLE, TITLF, IHR, IMIN, AP, IYR, IMON.IDAY 
COMMON /FACTOR/SFAC 
DATA AM/ ’ AM ’/ , PM/ ’ PM ’ / 

DATA GRAV/32. 2/, PI/3. 1415927/ 

DATA NAMFUL/ ’ FUEL. INP ’/ 

DATA NAMLOX/’LOX. INP ’/ 

DATA IOPEN/O/ 

1 FORMAT (El 5. 6) 

2 FORMAT (I5,5E15.6) 

3 FORMAT ( 1P4E15. 6) 

4 FORMAT( 1PE13. 5 , ’ ( ’ , E12. 5 , ’ , ’ , E12. 5, ’ ) ( ’ , E12. 5, ’ , * , E12. 5, ’ ) ’ ) 

5 FORMAT (/’ FREQ’ , 8X, ’ FREQ-NORM’ ,9X,’G(R) , ,11X,’G(I)’/) 

6 FORMAT (/2X, ’" FREQ" ’ ,7X, ’ "FREQ-NORM" ’ ,5X, ’ " /G1/"’,6X, 

* /G/"’/) 

7 FORMAT ( ’ " ’ ,A, ’ " ’ ) 

8 FORMAT(I5 , 1P3E15. 6) 

10 FORMAT (A20, 2X, 12.2,’: ’ ,12.2, A2,3X, 12.2, ,12.2, ’-’ ,12.2) 

SFAC=1.0 

WRITE(*,*)’ If you want frequency in rad/sec, hit enter.’ 

WRITE(*, ’ (A\) ’ ) ’ If you want it in Hertz, enter "H". ’ 

READ(*, ’ (A) ’ )ANS 

IF(ANS. EQ. ’H’ .OR. ANS. EQ. ’h’) SFAC=6. 283185 
LOPOLD=20 

CALL GETTIMUHR, IMIN, ISEC, 1100) 

CALL GETDAT ( IYR, IMON, I DAY) 

IYR=IYR-1900 
IFCIHR.LT. 12) THEN 
AP=AM 
ELSE 
AP=PM 

IF( IHR. GT . 12 ) IHR=IHR-12 
ENDIF 

20 CONTINUE 

WRITEC*, ’(AX)’)’ Is this setup for FUEL or OXIDIZER? Enter F or 0 
*. ’ 

READ(* , ’ (A) ’ )ANS 

IF(ANS. EQ. ’ F’ .OR.ANS.EQ. ’f’) THEN 

WRITE(* , ’ (A\) ’ ) ’ Is the name of the I/O file FUEL. INP? Y or N ’ 
READ(* , ’ (A) ’ )ANS 

IF(ANS.EQ. ’N’ .OR.ANS.EQ. ’n’) THEN 
WRITE(* , *) ’ Enter name of I/O file’ 

READ(* , ’ (A) ’ )NAMLIN 
ELSE 

NAMLIN=NAMFUL 

ENDIF 

ELSEIF(ANS. EQ. ’O’ .OR.ANS.EQ. ’o’ ) THEN 
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WRITE(* , ’ (A\) ’ ) ’ Is the name of the I/O file LOX.INP? Y or N 
READ(* , ’ (A) ’ )ANS 

I F ( ANS . EQ . ’ N ’ . OR . ANS . EQ . ’ n ’ ) THEN 
WRITE(* , * ) ’ Enter name of I/O file’ 

READ(*, ’ (A) ’ )NAMLIN 
ELSE 

NAMLIN=NAMLOX 

ENDIF 

ELSE 

WRITE(*,*)’ You did not enter F or 0. Try again’ 

GO TO 20 
ENDIF 

OPEN(UNIT=ll , FILE=NAMLIN) 

OPEN(UNIT=12 , FILE= ’SURF. DAT ’ ) 

WRITE(* , ’ (A\) ’ ) ’ If there is data stored enter Y ’ 

READ(* , ’ (A) ’ )ANS 

IF(ANS.EQ. ’N’ .OR. ANS. EQ. ’n’ ) THEN 
RSP0N=4 
GO TO 24 
ENDIF 

21 CONTINUE 
SPLIT =1.0 
LOPEND= 1 
C TITLE 

READ(11, ’ (A) ’ )TITLF 

WRITE(TITLE,10)TITLF,IHR,IMIN,AP,IMON,IDAY,IYR 
C TANK CONDITIONS 

READ( 11 , 1)V0L 
READ(11 , l)LFLOW 
READ(11 , 1 )KTANK 
C MANIFOLD CONDITIONS 

READ(11 , 1 )DENS 
READ(11 , l)TFLOW 
READ(11 , l)VOLMF 
READ(11,1)KMAN 
READ(11 , 1)PCHMB 
C ORFICE CONDITION 

READ(11 , 1 )DPROR 
A=SQRT ( GRAV* KTANK/DENS ) 

CTANK=DENS*VOL/KTANK 
CMAN=DENS*VOLMF/KMAN 
PMRAT=PCHMB/TFLOW 
AVGK=0 . 5* ( KTANK+KMAN ) 

READ(11,2)SEGMN 
DO 22 1=1 ,SEGMN 

READ( 11 , 2 )SECTN( I ) , PIPE1 ( I ) , PI PE2 ( I ) , PIPE3(I ),PIPE4(I),PIPE5(I) 
IF(SECTNU).EQ.O) THEN 
C BEND IN PIPE 

CALL BENDS (PI PEI (I ) ,PIPE2(I) ,PIPE3(I) ,PIPE4(I) , VALUE, DIME) 

AREAB=0.785398*DIME**2 

L(I)=VALUE 

AREA(I)=AREAB 
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DIA(I)=DIME 

ELSEIF(SECTN(I).EQ. 1 .OR. SECTN(I) . EQ. 9) THEN 
C STRAIGHT SECTION OR SPLIT 

VALUE=PIPE1(I) 

DIME=PIPE2(I ) 

AREAB=0. 785398*DIME**2 
L ( I )=VALUE 
AREA(I )=AREAB 
DIA(I)=0IME 

IF(SECTN(I ) . EQ. 9) THEN 
C SPLIT PIPE 

SPLIT=PIPE3( I ) 

WRITE ( ’(A,I3)’)’ Maximun no. of iterations is set at ’,LOPOLD 
WRITE(*, ’ (A\) ’ ) ’ Do you wish to change it? ’ 

READ(* , ’ ( A) ’ ) ANS 

IF(ANS. EQ. ’Y’ .OR. ANS. EQ. ’y’ ) THEN 
WRITE(* , ’ (A\) ’ ) ’ Enter maximum no. of iterations ’ 
READ(*,*)LOPOLD 
ENDIF 

LOPEND=LOPOLD 
ENDIF 

ELSEIF(SECTN( I ) . EQ. 2 ) THEN 
INLINE ACCUMULATOR 
PIPE1 - LEN - L 

PIPE2 - DIA - DIA 

PIPE3 - DEN 

PIPE4 - K 

L(I)=PIPE1(I) 

DIA( I )=PIPE2 ( I ) 

AREA(I)=0.25*PI*PIPE2(I)**2 
IF(PIPE3(I).EQ.0.0) PIPE3(I)=DENS 
IF(PIPE4( I ) . EQ. 0. 0) PIPE4( I )=AVGK 
PCAP(I)=PIPE3(I)*L(I)*AREA(I)*PMRAT/PIPE4(I) 

ELSEIF(SECTN( I) . EQ. 3) THEN 

TUNED STUB ACCUMULATOR 

SUPPRESSES OMEGA = (PI/2)/(L*SQRT(PIND*PCAP) ) 

PIPE1 - LEN - L 

PIPE2 - DIA - DIA 

PIPE3 - DEN 

PIPE4 - K 

L(I)=PIPE1(I) 

DIA(I)=PIPE2(I) 

AREA(I)=0.25*PI*DIA(I)**2 
IF(PIPE3(I ) . EQ. 0. 0) PIPE3(I)=DENS 
IF(PIPE4(I) . EQ.0.0) PIPE4( I )=AVGK 
PCAP( I )=PIPE3( I )*L( I )*AREA( I )*PMRAT/PIPE4(I ) 

PIND( I )=L ( I )/ (AREA( I )*GRAV*PMRAT ) 

ELSEIF(SECTN( I ) . EQ. 4.0R. SECTN(I) . EQ. 5) THEN 
HELMHOLTZ RESONATOR ACCUMULATOR 
PARALLEL RESONATOR ACCUMULATOR 

SUPPRESSES OMEGA = 1/SQRT(PIND*PCAP) 

PIPE1 - LEN - L 
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C PIPE2 - DIA - DIA 

C PIPE3 - VOL - AREA 

C PIPE4 - DEN 

C PIPE5 - K 

L(I)=PIPE1(I) 

DIA(I)=PIPE2(I) 

AREA(I)=PIPE3(I) 

I F ( PI PE4 ( I ) . EQ. 0 . 0) PIPE4(I)=DENS 
IF(PIPE5(I) . EQ.O.O) PIPE5(I)=AVGK 
PCAP( I )=PIPE4( I )*AREA( I ) *PMRAT/PIPE5( I ) 
PIND(I)=L(I)/(0.25*PI*DIA(I)**2*GRAV*PMRAT) 
ELSEIF(SECTN(I) . EQ. 6) THEN 


c 

PUMP 


c 

PIPE1 - LEN - 

L 

c 

PIPE2 - DIA - 

DIA 

c 

PIPE3 - DP/DM - 

AREA 

c 

PIPE4 - IND 

PIND 

c 

PIPE5 - CAP - 

PCAP 


L(I)=PIPE1(I) 

DIA(I)=PIPE2(I) 

AREA(I)=PIPE3(I) 

PCAP( I )=PIPE4( I )*PMRAT 
PIND(I )=PIPE5(I )/PMRAT 
ENDIF 

22 CONTINUE 

C 

C The first stage in this program is to define the parameters then 
we will begin the initial calculations. Because these parameters 
are as likely to change as not, a provision is made to update the 
parameters if necessary. 

C 

WRITE(12,*)’ ’ 

WRITE( 12 , * )TITLE 
WRITEC12 , *) ’ ’ 

WRITEU2,*) ’PRESENT CONDITIONS ARE AS FOLLOWS:’ 

WRITEC 12 , *) ’ FUEL TANK VOLUME=’,VOL 

WRITEC 12 , *) ’ LINE FLOW RATE= ’ , LFLOW 

WRITE( 12 , *) ’ BULK MOD. OF FUEL TANK= ’ , KTANK 

WRITEC 12 , *) ’VELOCITY OF SOUND IN FLUID=’,A 

WRITE(12,*) ’CAPACITANCE OF FUEL TANK= ’ , CTANK 

WRITE ( 12 , *) ’DENS= ’ , DENS 

WRITEC 12,*) ’TOTAL FLOW RATE= ’ ,TFLOW 

WRITE ( 12 , *) ’MANIFOLD VOLUME= ’ , VOLMF 

WRITEC 12 , *) ’ BULK MOD. OF MANIFOLD= ’ , KMAN 

WRITE( 12,*) ’ENGINE CHAMBER PRESSURE= ’ , PCHMB 

WRITE( 12,*) ’CAPACITANCE OF MANIFOLD= ’ , CMAN 

WRITE ( 12,*) ’PRESSURE DROP ACROSS ORIFICE= ’ , DPROR 

WRITEC 12,*)’ STATUS LENGTH AREA DIAMETER’ 

WRITEC 12 , 8) (SECTNC I ) , L(I ) , AREA (I ) , DIA(I ) , 1=1 ,SEGMN) 

WRITEC12,*)’ ’ 

WRITE( * , * ) ’ ’ 

WRITE(*, *)TITLE 
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WRITEC*,*)’ ’ 

WRITEC*,*)’ PRESENT CONDITIONS ARE AS FOLLOWS:’ 

WRITEC*,*)’ FUEL TANK VOLUME=’,VOL 

WRITEC*,*)’ LINE FLOW RATE= ’ , LFLOW 

WRITEC*,*)’ BULK MOD. OF FUEL TANK= ’ , KTANK 

WRITEC*,*)’ VELOCITY OF SOUND IN FLUID=’,A 

WRITEC*,*)’ CAPACITANCE OF FUEL TANK=’,CTANK 

WRITEC*,*)’ DENS= ’ , DENS 

WRITEC*,*)’ TOTAL FLOW RATE= ’ ,TFLOW 

WRITEC*,*)’ MANIFOLD VOLUME= ’ , VOLMF 

WRITEC*,*)’ BULK MOD. OF MANIFOLD= ’ , KMAN 

WRITEC*,*)’ ENGINE CHAMBER PRESSURE:’ ,PCHMB 

WRITEC*,*)’ CAPACITANCE OF MANIFOLD: ’ ,CMAN 

WRITEC*,*)’ PRESSURE DROP ACROSS ORIFICE: ’ ,DPROR 

WRITEC*,*)’ STATUS LENGTH AREA DIAMETER’ 

WRITEC*, 8) (SECTN(I) , L(I ) , AREA( I ) , DIACI) , 1=1 ,SEGMN) 

WRITEC*,*)’ If revisions on the design have been made’ 

WRITEC*,*)’ (changes in fuel, pipe length, diameter, bends, etc.)’ 

WRITEC* ,’ (A\) ’) ’ Please enter yes for revisions or no to continue. 

* ’ 

READ(* , ’ (A) ’ )ANS 

IFCANS.NE. ’Y’ .AND.ANS.NE. ’y’ ) GO TO 25 

23 CONTINUE 
RSPON=0 

24 CONTINUE 

CALL MODIFY(RSPON) 

C 

C THIS SECTION COMPUTES THE NEW ADMITTANCE OVER VARYING FREQUENCIES. 

C 

25 CONTINUE 
IF(SFAC.EQ.l.O) THEN 

WRITEC*,*)’ Enter range of frequencies in rad/sec ’ 

ELSE 

WRITEC*,*)’ Enter range of frequencies in Hertz ’ 

ENDIF 

WRITEC*,*)’ Low freq=l high freq=2 #pts=10’ 

READ ( * , * ) LFREQ , HFREQ , PTS 
IFCPTS.LT. 1) GO TO 29 
C 

C THIS SECTION WILL COMPUTE THE ADMITTANCE RATIO FOR THE FUEL TANK 

C AND THEN IT WILL COMPUTE THE ADMITTANCE RATIOS FOR EACH SEGMENT, 

C SINCE THERE ARE L( I) I=1,SEGMN LENGTHS, THEN THERE WILL BE AT LEAST 

C AS MANY ADMITTANCE RATIOS, THEREFORE I AM SETTING UP AN ARRAY FOR 

C EACH LENGTH L ( I ) HAVING AN ADMITTANCE RATIO G(I). 

C 

IPLT=0 

IF(PTS.GT.IXMAX) THEN 

WRITEC*,*)’ Maximum number of points for this option is IXMAX =’, 

* IXMAX 

WRITEC*,*)’ Do you want PTS reduced to IXMAX? Y or N’ 

READ(* , ’ (A) ’ )ANS 

IFCANS.EQ. ’N’ .OR.ANS.EQ. ’n’ ) GO TO 29 
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PTS=IXMAX 

ENDIF 

IF(LFREQ.EQ.O.O) LFREQ=1.0E-5 

WRITE ( * , * ) ’ Do you wish to plot ADMITTANCE as it is calculated? V 
*or N ’ 

READ(*, ’ (A) ’ )ANS 

IF(ANS.EQ. ’ Y ’ . OR. ANS. EQ. ’ y ’ ) THEN 

WRITE(*,*) ’ Enter estimated maximum value of admittance ’ 
READ(*,*)ADMMAX 
IPLT=1 
ENDIF 
SSIZE=0. 0 

IF(PTS.NE.l) SSIZE=(HFREQ-LFREQ)/(PTS-1) 

ZTOP=A/(GRAV*PMRAT) 

ZOR=2.0*DPROR/(LFLOW*PMRAT) 

252 CONTINUE 
TLT=0.0 
ISIZ=0 

DO 26 1=1 ,SEGMN 

IF(SECTN(I ) . EQ. 3.0R. SECTN( I) . EQ. 4) THEN 
TLT=TLT+DIA(I) 

ELSE 

TLT=TLT+L(I ) 

ENDIF 

IF(SECTN(I).LE. l.OR.SECTN(I) . EQ.9) THEN 
ZO ( I ) = ZT OP/AREA ( I ) 

WRITE(*,*)’ This section is ’,L(I),’ ft. long’ 

WRITE(*,*)’ How many segments should it be broken into? ’ 
READ(* , * )NSEC( I ) 

IF(NSEC(I).LE.l) NSEC ( I ) = 2 
ELSEIF(SECTN(I ) . EQ. 2 ) THEN 
ZO( I )=ZT0P/AREA( I ) 

NSEC C I ) = 2 
ELSE 

ZO( I)=SQRT ( PI ND ( I )/PCAP( I ) ) 

NSEC ( I ) = 2 
ENDIF 

ISIZ=ISIZ+NSEC( I ) 

IF(ISIZ.GT.IYMAX) THEN 
WRITE(*,*)’ Too many segments ’,ISIZ 
WRITE(*,*)’ Maximun is IYMAX =’,IYMAX,’ Try again.’ 

GO TO 252 
ENDIF 

26 CONTINUE 

TLT=TLT/(PI*A) 

C PLOT PIPE LAYOUT IN WINDOW 1 

CALL SETPLT 

CALL PIPPLOT (SEGMN,SECTN , PI PEI , PIPE2 , PIPE3 , PIPE4) 

IF(IPLT.EQ.l) THEN 
C PLOT ADMITTANCE IN WINDOW 2 

CALL LOWERW ( L FREQ , HFREQ , ADMMAX ) 

CALL ADMGRAPH( LFREQ , HFREQ , ADMMAX ) 
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ENDIF 

WRITE( 12,5) 

IF(IOPEN.NE.O. AND. LOPEND.NE. 1) THEN 
WRITE(13,*)’ ’ 

WRITE( 13 , *) ’ ’ 

WRITE(13,*)TITLE 
WRITE( 13 , * ) ’ ’ 

ENDIF 

DO 28 K=1 , PTS 
W=LFREQ+SSIZE*(K-1) 

XF(K)=W 

S=CMPLX (0.0, W*SFAC ) 

G(0)=CTANK*PMRAT*S 
G(0)=G(0)/SPLIT 
ZT(0)= 1 . 0/G(0) 

DO 281 KLOOP=l,LOPEND 
G1=G(0)+1. 0 
DO 27 1=1, SEGMN 
ZGEFF=G( 1-1 ) 

IF(SECTN(I) . LE. 1 .OR. SECTN( I ) . EQ. 9) THEN 
C BEND IN PIPE OR STRAIGHT SECTION 

TL=L(I)/A 

IF(KLOOP.NE. 1.AND.SECTN(I).EQ.9) THEN 
ZGEFF=G(I-1)+(SPLIT-1.0)/ZG(I-1) 

ENDIF 

G( I )= ( 1 . 0+CTANH(S*TL )/ ( ZGEFF*ZO( I ) ) )/( 1 . 0+ZGEFF*ZO( I ) * 

* CTANH(S*TL) ) 

ELSEIF(SECTN(I ) . EQ. 2) THEN 

C INLINE RESONATOR ACCUMULATOR 

G( I )= 1 . 0+PCAP( I )*S/ZGEFF 
ELSEIF(SECTN( I ) . EQ. 3 ) THEN 
C TUNED STUB ACCUMULATOR 

G( I ) = 1 . 0+CT ANH ( S*SQRT ( PIND( I ) *PCAP( I) ) )/(ZO( I )*ZGEFF) 
ELSEIF(SECTN(I) . EQ.4) THEN 
C HELMHOLTZ RESONATOR ACCUMULATOR 

G ( I )=S*PCAPd )/( 1 . 0+PINDd )*PCAPd )*S**2 ) 

G(I )=1 . 0+G(I)/ZGEFF 
ELSEIF(SECTN(I ) . EQ. 5) THEN 
C PARALLEL RESONATOR ACCUMULATOR 

Gd) = PINDd)*PCAPd)*S**2+1.0 
G(I)=G(I)/(G(I )+PINDd )*S*ZGEFF) 

ELSEIF(SECTN(I ) . EQ. 6) THEN 
C PUMP 

Gd) = d.O+PCAPd)*S/ZGEFF)/d.O+(PINDd)*S+AREAd))* 

* ( PCAP(I )*S+ZGEFF) ) 

ENDIF 

Gl=Gl*Gd ) 

G(I )=G(I )*ZGEFF 
ZT(I)=1.0/G(I) 

27 CONTINUE 

G(SEGMN+1 )=1 . 0+CMAN*PMRAT*S/G( SEGMN) 

G1=G1*G(SEGMN+1 ) 
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G(SEGMN+1)=G(SEGMN+1 )*G(SEGMN) 

G (SEGMN+2 ) = 1 . 0/ ( 1 . 0+ZOR*G ( SEGMN+ 1 ) ) 

Gl=Gl*G(SEGMN+2) 

G (SEGMN+2 ) =G ( SEGMN+ 2 ) *G ( SEGMN+ 1 ) 

ZG ( SEGMN ) = ZOR/ ( ZOR*CMAN*PMRAT*S+ 1.0) 

IF(SEGMN.NE. 1) THEN 
DO 271 I=SEGMN-1 , 1 ,-1 
ZGEFF=ZG(I+1 ) 

Z0EFF=Z0(I+1 ) 

IF(SECTN( 1+1 ) . LE. 1 .OR. SECTN(I+1 ) . EQ. 9) THEN 
C BEND IN PIPE OR STRAIGHT SECTION 

TL=(l(I)+L(I+l))/A 

CAPN= ( ZOEFF-ZT ( I- 1 ) )/( ZOEFF+ZT ( 1-1 ) ) 
CAPM=(ZOEFF-ZGEFF)/(ZOEFF+ZGEFF) 

CFAC=CEXP(-2.0*S*TL) 

RHS=(Z0EFF+ZGEFF)*(1.0-CAPN*CAPM*CFAC)*CEXP(S*L(I+1)/A) 

CFAC=CAPN*CFAC*CEXP(2.0*S*L(I+1)/A) 

ZG( I )=(RHS-ZOEFF*( 1 . 0-CFAC) )/( 1 . 0+CFAC) 

IF(SECTN( 1+1 ) . EQ. 9) THEN 
ZG ( I ) = ZG ( I )/SPLIT 
ENDIF 

ELSEIF(SECTN(I+1) . EQ. 2 ) THEN 
C INLINE RESONATOR ACCUMULATOR 

ZG(I)=ZGEFF/(ZGEFF*PCAP(I+1)*S+1.0) 

ELSEIF(SECTN(I+1 ) . EQ. 3) THEN 
C TUNED STUB ACCUMULATOR 

ZG( I )=ZOEFF/CTANH(S*SQRT(PIND( 1+1 )*PCAP( 1+1 ) ) ) 

ZG(I )= (ZG(I )*ZGEFF)/(ZG(I)+ZGEFF) 

ELSEIF(SECTN(I+1 ) . EQ. 4) THEN 
C HELMHOLTZ RESONATOR ACCUMULATOR 

ZG(I)=(1.0+PIND(I+1)*PCAP(I+1)*S**2)/(PCAP(I+1)*S) 

ZG( I )=(ZG(I )*ZGEFF)/(ZG(I )+ZGEFF) 

ELSEIF(SECTN( 1+1 ) . EQ. 5 ) THEN 
C PARALLEL RESONATOR ACCUMULATOR 

ZG(I)=ZGEFF+PIND(I+1)*S/(PIND(I+1)*PCAP(I+1)*S**2+1.0) 
ELSEIF(SECTN( 1+1 ) . EQ. 6 ) THEN 
C PUMP 

ZG(I)=ZGEFF+PIND(I+1)*S-AREA(I+1) 

ZG(I)=ZG(I)/(1. 0+ZG( I )*PCAP( 1+1 )*S) 

ENDIF 
271 CONTINUE 
ENDIF 

CALL FREQRS ( YF , ZF , K , IXMAX , IYMAX , KLOOP , ERRP , WVAL ) 
IF(KLOOP.GT.l. AND.ERRP.LT. 0.001) GO TO 282 
281 CONTINUE 

IF(LOPEND.EQ.l) GO TO 282 
IF(IOPEN.EQ.O) THEN 
OPEN(UNIT= 13 , FILE= ’ SURF. ERR ’ ) 

WRITEC13,*)’ ’ 

WRITE(13, *) ’ ’ 

WRITE(13, +)TITLE 
WRITE(13,*)’ ’ 
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IOPEN= 1 
ENDIF 

WRITE ( 13 , ’ ( ’ jw =’’,F8.1,’’ after’ ’ ,13, ’ ’ iterations’’, 

* ” has error of”,F8.3,”% out of”,F8.3)’) 

* W, LOPEND , 100 . 0*ERRP , WVAL 
282 CONTINUE 

MAG=CABS(G(SEGMN+2) ) 

MAG1=CABS(G1) 

WN=W*TLT 

WRITE ( 12 , 3 )W, WN , G(SEGMN+2) 

IF(IPLT.EQ.O) THEN 
X(K, 1 )=W 
Y(K,1)=MAG 
ELSE 

CALL NEXPT(W,MAG) 

ENDIF 

28 CONTINUE 
IF(IPLT.EQ.O) THEN 

CALL ALLPT (X , Y , PTS) 

ENDIF 

CALL ENDPLT 

WRITE(*, ’ (A\) ’ ) ’ Do you wish to plot the surface? ’ 

READ(* , ’ (A) ’ )ANS 

IF(ANS.EQ. ’Y’ .OR.ANS.EQ. ’y’ ) THEN 
CALL PLOTSU(X , Y , Z ,XF, YF, ZF, NPTS , PTS, IXMAX, IYMAX) 

ENDIF 

WRITE(* , ’ (A\) ’ ) ’ Do you wish to plot contours? ’ 

READ(*, ’ (A) ’ )ANS 

IF(ANS.EQ. ’Y’ .OR.ANS.EQ. ’y’) THEN 
CALL PLTCON (X , Y , Z , XF , YF , ZF , NPTS , PTS , IXMAX , IYMAX ) 

ENDIF 

29 CONTINUE 

WRITER, ’(A\)’)’ Enter E to exit, F to run new frequency range, or 

* C to run a new case ’ 

READ(* , ’ (A) ’ )ANS 

IF(ANS.EQ.’F’.OR.ANS.EQ.’f’) GO TO 25 
IF(ANS. EQ. ’E’ .OR.ANS.EQ. ’e’ ) RETURN 
IF(ANS.EQ. ’ C ’ .OR.ANS.EQ. ’c’) THEN 

WRITE(* , ’ (A\) ’ ) ’ Do you wish to use old data with changes? Y or N 

* ’ 

READ(* , ’ (A) ’ )ANS 

IF(ANS.EQ. ’Y’ .OR.ANS.EQ. ’y’ ) GO TO 23 

WRITE(*, ’ (A\) ’ ) ’ Does INPUT file need to be rewound? Y or N ’ 
READ(*, ’ (A) ’ )ANS 

IF(ANS. EQ. ’Y’ .OR.ANS. EQ. ’y’ ) REWIND 11 
GO TO 21 
ENDIF 

WRITE(*,*)’ You did not enter E, F, or C. Try again.’ 

GO TO 29 
END 

SUBROUTINE ADMGRAPH( LFREQ , HFREQ , ADMMAX ) 

C Plots admittance curve 
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CHARACTER*40 TITLE 
CHARACTER*20 TITLF 
INTEGER*2 IHR, IMIN , IYR , IMON,IDAY 
CHARACTER*2 AP 

COMMON /WCAT IT /TITLE, TITLF, I HR , I MI N , AP , I YR , IMON , I DAY 
COMMON /NOCOL/MODE , MODET , NTROWS , NTCOLS , NPROWS , NPCOLS 
COMMON /FACTOR/SFAC 
REAL LFREQ 
1 FORMAT (F6. 3) 

XMIN=LFREQ 

XMAX=HFREQ 

YMIN=0 . 0 

YMAX=ADMMAX 

XMAJ=0.25*(XMAX-XMIN) 

YMAJ = 0 . 2 5* ( YMAX-YM I N ) 

IF(MODE. NE. 18) THEN 
CALL QPTXT (40, TITLE, 7, 17, 11) 

ELSE 

CALL QPTXT (40 , TITLE , 7,17,14) 

ENDIF 

CALL QXAXIS ( XMIN , XMAX , XMAJ , 0 , - 1 , 2 ) 

IF(SFAC.EQ.l) THEN 

CALL QPTXTA(20, ’Frequency - rad/sec ’,7) 

ELSE 

CALL QPTXTA(20,’ Frequency - Hertz ’,7) 

ENDIF 

CALL QYAXIS ( YMIN , YMAX , YMAJ ,0,0,0) 

CALL QPTXTD(8, ’Adm. ’,7) 

CALL QYAXIS (YMIN , YMAX , YMAJ , 0 , -1 , 2 ) 

RETURN 

END 

SUBROUTINE ALLPT(X , Y , PTS) 

C Supervises plot of admittance after calculations 

INTEGERS PTS 
REAL X(PTS) ,Y(PTS) 

A0MMAX=Y( 1 ) 

DO 21 1=2, PTS 

IF(Y( I ) . GT. ADMMAX) ADMMAX=Y(I ) 

21 CONTINUE 

CALL LOWERW(X(l),X(PTS), ADMMAX) 

CALL ADMGRAPH ( X ( 1 ) , X ( PTS ) , ADMMAX ) 

CALL QTABL(1,PTS,X,Y) 

RETURN 

END 

SUBROUTINE BENDS (PI PEI , PI PE2 , PI PE3 , PI PE4, VALUE , DIME) 
C Computes effective straight pipe for bend 

REAL LBEND, INRAD, INERT, LPRME.NEWLN 
BENDR=0.0174533*ABS(PIPE2) 

LBEND=PIPE1*BENDR 
ARBND=0. 785398*PIPE3**2 
INRAD=PIPE1-0.5*PIPE3 
0TRAD=PIPEl+0. 5*PIPE3 
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RATIO= INRAD/OTRAD 
X=RATIO 

CALL GINERT (ABS( PIPE2 ) , X , Y) 

INERT=(Y*(OTRAD-INRAD) )/ARBND 
LPRME=LBEND/ARBND 
NEWLN=LPRME+ INERT 
GAMMA=NEWLN/LPRME 
VALUE=GAMMA*(LBEND+2 . 0*PIPE4) 

AREAB= ARBND/SQRT ( GAMMA ) 

DIME=2.0*SQRT(AREAB/3. 1415927) 

RETURN 

END 

SUBROUTINE BNSECT(J , ITYPE, POINT , PIPE1 , PIPE2 , PIPE3 , PIPE4) 

C Computes plot coordinates for a bend 

COMMON /PIPPXY/X , XH , XL , Y , YH , YL , XMIN , XMAX , YMIN , YMAX , SINA , COSA 
COMMON /ARCCON/XC , YC , RAD , ANG , ANGL E 
REAL POINT(8 , 200 ) 

INTEGERS ITYPE(200) 

C FIRST STRAIGHT SECTION OF BEND 

IF(PIPE4.NE. 0.0) CALL STSECT(J , ITYPE, POINT , PIPE4 , PIPE3 ) 

C CURVED SECTION OF BEND 

IF(PIPE2.GE. 0.0) THEN 
XC=X-SINA*PIPE1 
YC=Y+C0SA*PIPE1 
DIA= 0.5 
ELSE 

XC=X+SINA*PIPE1 

YC=Y-C0SA*PIPE1 

DIAs-0.5 

ENDIF 

J=J+1 

ITYPE(J)=0 

POINT ( 1 , J )=XC 

POINT ( 2 , J ) =YC 

POINT (3 , J )=ANG 

ANG=ANG+0.01745329*PIPE2 

ANGLE=ANGLE+0. 5*PIPE2 

RANG=0.01745329*ANGLE 

COSA=COS(RANG) 

SINA=SIN(RANG) 

RAD=PIPE1-DIA*PIPE3 

POINT (4, J )=ANG 

POINT ( 5 , J )=RAD 

X0=XC-RAD 

Y0=YC+RAD 

X1=XC+RAD 

Y1=YC-RAD 

X2=XH 

Y2=YH 

SLENTH=2.0*RAD*SIN(0. 00872665*ABS(PIPE2 ) ) 

XH=X2+COSA*SLENTH 

YH=Y2+SINA*SLENTH 
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X3=XH 

Y3=YH 

IFCDIA.LT. 0.0) THEN 
HOLD=X2 
X2=X3 
X3=HOLD 
HOLD=Y2 
Y2=Y3 
Y3=HOLD 
ENDIF 

RAD=PIPE1+DIA*PIPE3 

X0=XC-RAD 

Y0=YC+RAD 

X1=XC+RAD 

Y1=YC-RAD 

X2=XL 

Y2=YL 

SLENTH=2 . 0*RAD*SIN(0 . 00872665*ABS(PIPE2 ) ) 

XL=X2+COSA*SLENTH 

YL=Y2+SINA*SLENTH 

X3=XL 

Y3=YL 

IFCDIA.LT. 0.0) THEN 
HOLD=X2 
X2=X3 
X3=HOLD 
HOLD=Y2 
Y2=Y3 
Y3=HOLD 
ENDIF 
J=J+1 

ITYPEC J )=0 

POINT C 1 , J ) = POINT ( 1 , J-l ) 

POINT ( 2 , J )= POINT ( 2 , J-l ) 

POINT ( 3 , J )=POINT ( 3 , J-l ) 

POINT (4, J)=POINT (4, J-l ) 

POINT(5, J)=RAD 

SLENTH=2 . 0*PIPE1*SIN(0. 00872665*ABS(PIPE2 ) ) 

X=X+COSA*SLENTH 

Y=Y+SINA*SLENTH 

XMIN=AMIN1 (X,XL ,XH,XMIN) 

XMAX=AMAX1(X ,XL ,XH,XMAX) 

YMIN=AMIN1 (Y, YL , YH, YMIN) 

YMAX= AMAX 1 ( Y , YL , YH , YMAX ) 

C LAST STRAIGHT SECTION OF BEND 

ANGLE=ANGLE+0. 5*PIPE2 
RANG=0 . 01745329*ANGLE 
COSA=COS(RANG) 

SINA=SIN(RANG) 

J=J+1 
ITYPE( J )=1 
POINT ( 1 , J )=XH 
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POINT (2 , J )=YH 

POINT ( 3 , J )=XL 

POINT (4, J )=YL 

X=X+COSA*PIPE4 

XH=X-0. 5*SINA*PIPE3 

XL=X+0 . 5*SINA*PIPE3 

Y=Y+SINA*PIPE4 

YH=Y+0. 5*COSA*PIPE3 

YL=Y-0.5*COSA*PIPE3 

POINT ( 5 , J )=XH 

POINT ( 6 , J )=YH 

POINT(7, J)=XL 

POINT (8 , J )=YL 

XMIN=AMIN1 (X ,XL , XH , XMIN ) 

XMAX= AMAX1 ( X , XL , XH , XMAX ) 

YMIN=AMIN1(Y, YL, YH, YMIN) 

YMAX= AMAX1 ( Y , YL , YH , YMAX ) 

RETURN 

END 

COMPLEX FUNCTION CCOSH(S) 

C Evaluates the complex hyperbolic cosine 

COMPLEX S 
REAL LAM DA, MU 
LAMDA=REAL(S) 

MU=AIMAG(S) 

COSHR=COSH ( LAM DA ) *COS ( MU ) 

COSHI=SINH(LAMDA)*SIN(MU) 

CCOSH= CMPLX ( COSHR , COSHI ) 

RETURN 

END 

COMPLEX FUNCTION CSINH(S) 

C Evaluates the complex hyperbolic sine 

COMPLEX S 
REAL LAMDA, MU 
LAMDA=REAL(S) 

MU=AIMAG(S) 

SINHR=SINH( LAMDA) *COS(MU) 

SINHI=COSH( LAMDA)*SIN(MU) 

CSINH=CMPLX(SINHR , SINHI ) 

RETURN 

END 

COMPLEX FUNCTION CTANH(S) 

C Evaluates the complex hyperbolic tangent 

COMPLEX CCOSH, CSINH, S 
CTANH=CSINH(S )/CCOSH(S) 

RETURN 

END 

SUBROUTINE ENDPLT 
C Closes plot routines 

COMMON /WCAPAS/IFRST 

COMMON /NOCOL/MODE , MODET , NTROWS , NTCOLS , NPROWS , NPCOLS 
21 CONTINUE 
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CALL QONKEY(IKEY) 

IF(IKEY.EQ.O) GO TO 21 
CALL QINKEY( IEXTEN , I KEY) 

IF(IKEY. EQ.80.0R. I KEY. EQ. 112) CALL QPSCRN 
CALL QSMODE(MODET) 

RETURN 

END 

SUBROUTINE FREQRS(YF , ZF , K, IXMAX, IYMAX, KLOOP, ERRP.WVAL) 

C Computes pressure transfer function 

COMPLEX S , ZT ( 0 : 76 ) , ZG ( 76 ) , LITTLN , CAPM , CAPN , ZFAC , TOP , BOTTOM , PRAT 
REAL AREA(75) , DIA(75) ,L (75), PI PE 1(75) ,PIPE2(75) , PIPE3(75 ) , 

* PIPE4(75) ,PIPE5(75),ZO(76), PIND(75 ) , PCAP( 75) 

REAL KMAN,KTANK,LFLOW 

INTEGER*2 SECTN(75) ,SECT,SEGMN 

COMMON /RELVAL/A , AREA , AREAB , CMAN , CTANK , DENS , DIA , DIME , DPROR , KMAN , 

* KTANK, L , LFLOW, PCHMB, PIPE1 ,PIPE2 , PIPE3 , PIPE4, PIPE5 , 

* TFLOW , VALUE , VOL , VOLMF , PMRAT , SPLIT , PCAP , PIND 
COMMON /INTVAL/SECT , SECTN , SEGMN , NSEC( 75 ) , NPTS , LOPEND , LOPOLD 
COMMON /FREQ/S, ZT,ZG,ZO 

INTEGERS IXMAX, IYMAX 

REAL YF( IYMAX ) , ZF( IXMAX , IYMAX ) , PRATO( 2 , 75 ) 

LITTLN=S/A 
SUMX=0 . 0 
M= 1 

ERRP=0. 0 

DO 22 I=SEGMN ,1,-1 

CAPN= (ZO( I )-ZT (I-l))/(ZO(I )+ZT ( 1-1 ) ) 
CAPM=(ZO(I)-ZG(I))/(ZO(I)+ZG(I) ) 

ZFAC=ZO( I )/ (ZO(I)+ZG(I)) 

LSEC=NSEC(I) 

DX=0 . 0 

I F( SECTN ( I ) . EQ. 3 . OR . SECTN ( I ) . EQ. 4) THEN 
DX=DIA( I )/ ( LSEC-1 ) 

ELSE 

DX=L ( I )/( LSEC-1 ) 

ENDIF 

BOTTOM= 1 . 0-CAPM*CAPN*CEXP(-2 . 0*LITTLN*L(I ) ) 

DO 21 J = 1 , LSEC 
X=DX*(J-1) 

IF(SECTN( I ) . GT . 1 . AND. SECTN ( I ) . LT. 6) THEN 
I F ( J . EQ. LSEC) PRAT=ZT(I-1)/(ZT(I-1)+ZG(I)) 

ELSE 

TOP=CEXP(-LITTLN*X)-CAPN*CEXP(-LITTLN*(2 . 0*L( I )-X) ) 
PRAT=ZFAC*TOP/BOTTOM 
ENDIF 

IF(J.NE.l) THEN 
SUMX=SUMX+DX 
M=M+1 

ZF(K , M)=CABS(PRAT ) 

IF(K.EQ.l) YF(M)=SUMX 
ELSE 

IF(I.EQ. SEGMN) THEN 
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ZF( K , M)=CABS(PRAT ) 

IF(K.EQ.l) YF(M)=SUMX 

ENDIF 

ENDIF 

IF(J.NE.l.AND.J.NE.LSEC) GO TO 21 
PRATN=CABS(PRAT) 

IF(KLOOP.NE.l) THEN 
IF(J.EQ.l) THEN 

ERRN=ABS( ( PRATN-PRATO( 1,1) )/PRATN ) 

ELSE 

ERRN=ABS( (PRATN-PRATO(2, I) )/PRATN) 

ENDIF 

ERRP= AMAX 1 ( ERRP , ERRN ) 

IF(ERRP.EQ.ERRN) WVAL=PRATN 
ENDIF 

IF(J.EQ.l) PRATO(l,I)=PRATN 
IF(J.EQ.LSEC) PRATO( 2 , I )=PRATN 

21 CONTINUE 

22 CONTINUE 
IF(K.EQ.l) NPTS=M 
RETURN 

END 

SUBROUTINE GINERT( BEND, X , Y) 

C Evaluates curve fit of inertance of bends 

DIMENSION B ( 3 ) 

DATA B/0.0,0. 7877014E-02 ,-0. 2814679E-04/ 

A=B(1)+(B(2)+B(3)*BEND)*BEND 

Y=A*(X-1.0)**2 

RETURN 

END 

SUBROUTINE HHSECT (J , ITYPE , POINT , LEN , DIA , VOL) 

C Computes plot coordinates for Helmholtz resonator 

COMMON /PIPPXY/X , XH , XL , Y , YH , YL , XMIN , XMAX , YMIN , YMAX , SINA , COSA 
REAL LEN , POINT(8 , 200) 

INTEGERS ITYPE(200) 

XOLD=X 

XHOLD=XH 

XLOLD=XL 

YOLD=Y 

YHOLD=YH 

YLOLD=YL 

SINOLD=SINA 

COSOL D= COSA 

DIAM=SQRT((XH-XL)**2+(YH-YL)**2) 

CALL TSSECT ( J , ITYPE , POINT , LEN , DIA) 

XC=0.5*(XOLD+X) 

YC=0.5*(YOLD+Y) 

XOLD=X 

YOLD=Y 

SINA=COSOLD 

COSA=-SINOLD 

X=XC+COSA* ( LEN+0 . 5*DIAM ) 
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Y=YC+SINA* ( LEN+O . 5*DIAM) 

SIDE=VOL**0. 3333333 

CALL STSECT(J,ITYPE, POINT, SIDE, SIDE) 

X=XOLD 

Y=YOLD 

SINA=SINOLD 

COSA=COSOLD 

DIAM=SQRT ( ( XHOLD-XLOLD ) **2+ ( YHOLD-YLOLD ) **2 ) 

XH=X-0.5*SINA*DIAM 

XL=X+0.5*SINA*DIAM 

YH=Y+0. 5*COSA*DIAM 

YL=Y-0.5*C0SA*DIAM 

RETURN 

END 

SUBROUTINE LOWERW ( LFREQ , HFREQ , ADMMAX ) 

C Sets up lower plotting window 

COMMON /NOCOL/MODE , MODET , NTROWS , NTCOLS , NPROWS , NPCOLS 

COMMON /ADMCOL/ADMBAC, ADMLIN 

INTEGER ADMBAC, ADMLIN 

REAL LFREQ 

XMIN=LFREQ 

XMAX=HFREQ 

YMIN=0 . 0 

YMAX= ADMMAX 

XORG=XMIN 

YORG=YMIN 

XLEN=0.01*(XMAX-XMIN) 

YLEN=0.01*(YMAX-YMIN) 

XMIN=XMIN-XLEN 

XMAX=XMAX+XLEN 

YMIN=YMIN-YLEN 

YMAX=YMAX+YLEN 

JCOLl= 150 

JCOL2=550 

IF(MODE. EQ. 6) THEN 
JROW1=20 
JROW2=79 
ELSE 

JROW1=40 

IF(MODE. EQ. 16) JROW2=134 

IF(MODE. EQ. 18) JROW2=199 

ENDIF 

YOVERX=l . 0 
I0PT=0 
ASPECT= 1.35 

CALL QPLOT ( JCOL1 , JCOL2 , JROW1 , JROW2 , XMIN , XMAX , YMIN , YMAX , 
* XORG , YORG , IOPT , YOVERX , ASPECT ) 

IF(MODE.NE.6) THEN 
CALL QPREG(0, ADMBAC) 

ENDIF 

CALL QSETUP(0, ADMLIN, -2, ADMLIN) 

RETURN 
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END 

SUBROUTINE MODIFY(RSPON) 

C Allows modifications to input data 

REAL AREA ( 75 ) , DIA( 7 5),L(75),PIPE1(75), PIPE2( 75 ) , PIPE3 ( 75 ) , 

* P I PE4 ( 75) ,PIPE5(75),PIND(75) , PCAP(75) 

REAL KMAN, KTANK, LFLOW 

INTEGERS SECTN ( 75 ) , RSPON , SECT , SEGMN 
CHARACTER ANS*1 

CHARACTER*8 VARVAL ( 9 ) , VARU ( 9 ) , VARL (9) , NAME 

CHARACTERS NAMLIN 

CHARACTER*40 TITLE 

CHARACTER*20 TITLF 

INTEGER*2 IHR, IMIN, IYR, IMON, I DAY 

CHARACTERS AP 

COMMON /WCATIT/TITLE , TITLF , IHR , IMIN , AP , IYR , IMON , IDAY 

COMMON /RELVAL/A , AREA , AREAB , CMAN , CTANK, DENS , DIA , DIME , DPROR , KMAN , 

* KTANK, L , LFLOW , PCHMB, PIPE1 , PIPE2 ,PIPE3,PIPE4,PIPE5, 

* TFLOW , VALUE , VOL , VOLMF , PMRAT , SPLIT , PCAP , PIND 
COMMON /INTVAL/SECT , SECTN , SEGMN , NSEC ( 75 ) , NPTS , LOPEND , LOPOLD 
COMMON /WCAOUT/NAMLIN 


DATA 

GRAV/32 . 2/, PI/3. 

141593/ 


DATA 

VARVAL/’ DENS = 

DPROR 

= ’ , ’ KMAN = ’ , 

* 

’ KTANK = 

’ , ’ LFLOW 

=’ , ’ PCHMB = ’ , ’ TFLOW =’ , 

* 

’ VOL = 

’ , ’ VOLMF 

= ’/ 

DATA 

VARU/ ’DENS 

’ DPROR 

, ’ KMAN 

* 

’KTANK 

’LFLOW 

, ’PCHMB ’, ’TFLOW 

* 

’VOL 

’VOLMF 

/ 

DATA 

VARL/ ’dens 

'dpror 

, ’ kman ’ , 

* 

’ktank ’, 

’lflow 

,’pchmb ’,’tflow ’, 

* 

’vol 

’volmf 

/ 


1 FORMAT ( 1PE15 . 6 ) 

2 FORMAT (I5.1P5E15.6) 

3 FORMAT (15, 1P3E15.6) 

4 FORMAT ( ’ This segment is a bend of ’ , 1PE13.5, ’ deg and radius of’, 

* E13.5) 

5 FORMAT(’ This segment is straight ’,1PE13.5,’ diameter pipe ’, 

* E13 . 5 , ’ ft. long’) 

6 FORMAT (A8,1PE13.5,10X,A8,E13.5) 

7 FORMAT (’ TITLE = ’ ,A20) 

10 FORMAT(A20, 2X.I2. 2, ’:’ ,12.2, A2,3X, 12.2, ,12.2, ’-’ ,12.2) 

11 FORMAT ( ’ This segment is ’,12,’ way split ’.1PE13.5,’ dia. ’ , 

* ’ pipe ’ , E13 . 5 , ’ ft. long’) 

12 FORMAT ( ’ This segment is a pump with length =’,1PE13.5,’ dia = ’, 

* E13. 5/5X, ’dp/dm =’,E13.5,’ capacitance =’,E13.5, 

* ’ inductance = ’ ,E13.5) 

13 FORMAT ( ’ This segment is a tuned pipe ’,1PE13.5,’ long & dia =’, 

* E13.5) 

14 FORMAT(’ This segment is a Helmholtz resonator with’/5X, ’ length = 

* , 1PE13. 5 , ’ dia =’,E13.5,’ and vol =\E13.5) 

15 FORMAT ( ’ This segment is a parallel resonator with’/5X, ’ length = ’ 

* 1PE13.5, ’ dia = ’ ,E13.5, ’ and vol =’,E13.5) 

16 FORMAT(’ This segment is a’,lPE13.5,’ long inline acc. with’, 
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* ’ diameter of’ ,E13.5) 

AVGK=0. 5*(KTANK+KMAN) 

ICHG=0 

IF(RSPON . EQ. 4) GO TO 21 

WRITE(*,*)’ Do you wish to change engine & fluid parameters ’ 
READO, ’ (A) ’ )ANS 

IF(ANS.NE. ’Y’ .AND.ANS.NE. ' y * ) GO TO 29 

WRITE ( *,*) ’ Do you wish to change all of the parameters?’ 

READ(* , ’ (A) ’ )ANS 

IF(ANS.NE. ’Y’ .AND.ANS.NE. ’ y ’ ) ICHG=1 

21 CONTINUE 
IF(ICHG.EQ.O) THEN 

WRITE(* , ’ (A\) ’ ) ’ Enter TITLE (20 characters max.) ’ 

READ(* , ’ (A) ’ )TITLF 

WRITE (TITLE ,10)TITLF,IHR,IMIN,AP, IMON , I DAY, IYR 
WRITE(* , ’ (A\) ’ ) ’ Enter FUEL TANK VOLUME (ft"3)’ 

READ(*,*)VOL 

WRITE(*, ’ (A\) ’ ) ’ Enter FLOW RATE inside LINE (lbm/sec)’ 
READ(*,*)LFLOW 

WRITE(* , ’ (A\) ’ ) ’ Enter BULK MODULUS of fluid inside TANK (lb /ft 
* 2 )’ 

READ(* , *)KTANK 

WRITE(* , ’ (A\) ’ ) ’ Enter FUEL DENSITY (lbm/ft~3)’ 

READ(* , *)DENS 

WRITE(* > ’(A\)’)’ Enter TOTAL FLOW RATE inside ENGINE (lbm/sec)’ 
READ(*,*)TFLOW 

WRITE(*,’(A\)’)’ Enter MANIFOLD VOLUME (ft~3)’ 

READ( * , *)VOLMF 

WRITE(* , ’ (A\) ’ ) ’ Enter BULK MODULUS of fluid inside MANIFOLD (lb 
*/ft~2) ’ 

READ(*,*)KMAN 

WRITE(* , ’ (A\) ’ ) ’ Enter CHAMBER PRESSURE in ENGINE (lbf/ft~2)’ 
READ(* , * )PCHMB 

WRITE(*,’(A\)’)’ Enter PRESSURE DROP across ORIFICE (lbf/ft~2)’ 

READ(*,*)DPROR 

A=SQRT(GRAV*KTANK/DENS) 

CTANK=DENS*VOL/KTANK 

CMAN=DENS*VOLMF/KMAN 

PMRAT=PCHMB/TFLOW 

ELSE 

GO TO 24 

22 CONTINUE 

WRITER,*)’ VARIABLE NAMES AND DESCRIPTIONS’ 

WRITE(*,*) ’ ’ 

WRITE(*,*)’ TITLE - title (20 characters max.) ’ 

WRITE(*,*) ’ DENS - density of fluid (Ibrn/ft^) ’ 

WRITE(*,*)’ DPROR - pressure drop across orfices ( 1 bf/f t^2 ) ’ 

WRITE(*,*)’ KMAN - bulk modulus in manifold (lbf/ft~2) ’ 

WRITE(*,») ’ KTANK - bulk modulus in tank (lbf/ft"'2) ’ 

WRITE(*,*)’ LFLOW - mass flow rate of fluid (lbm/sec) ’ 

WRITE(*,*)’ PCHMB - chamber pressure (lbf/ft"2) ’ 

WRITE(*,*)’ TFLOW - total mass flow inside engine (lbm/sec)’ 
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WRITEC*,*)’ VOL - volume of storage tank (ft" 3) ’ 

WRITEC*,*)’ VOLMF - volume of manifold (ft"3) ’ 

WRITE(*,*)’ ’ 

GO TO 25 

23 CONTINUE 

WRITEC*,*)’ VARIABLE NAMES AND VALUES’ 

WRITEC*,*)’ ’ 

WRITEC*, 7)TITLF 

WRITE(*, 6 )VARVAL( 1), DENS, VARVALC 2),DPROR, 

* VARVALC 3), KMAN, VARVALC 4 ) , KT ANK , VARVAL ( 5),LFLOW, 

* VARVALC 6 ),PCHMB, VARVALC 7) ,TFLOW, VARVALC 8), VOL, 

* VARVALC 9), VOLMF 

24 CONTINUE 
WRITEC*,*)’ ’ 

WRITEC*,*)’ Enter ? to print variable names & descriptions’ 

WRITEC*,*)’ # to print variable names & values’ 

WRITEC*,*)’ TITLE to enter new title’ 

WRITEC*,*)’ END when all changes have been made’ 

WRITEC*,*)’ ’ 

25 CONTINUE 

WRITEC* ,’ (A\) ’) ’ Enter variable name and new value, END, ?, or 

* # ’ 

CALL ZREADCNAME, VALUE) 

IFCNAME.EQ. ’?’) GO TO 22 

IFCNAME.EQ. ’#’) GO TO 23 

IFCNAME.EQ. ’END’. OR. NAME. EQ. ’end’) GO TO 28 
IFCNAME.EQ. ’TITLE’ .OR. NAME. EQ. ’title’) THEN 
WRITEC* ,’ (A\) ’) ’ Enter new TITLE (20 characters max.) ’ 

READC* , ’ (A) ’ )TITLF 

WRITE (TITLE , 10 )TITLF, IHR , IMIN , AP , IMON , I DAY , IYR 
GO TO 25 
ENDIF 

DO 26 11=1,9 
I=II 

IF(NAME. EQ. VARU( I ) . OR. NAME. EQ. VARL(I) ) GO TO 27 

26 CONTINUE 

WRITEC*,*)’ Invalid name, try again’ 

GO TO 22 

27 CONTINUE 

IFCI.EQ. 1) DENS=VALUE 
IFCI.EQ. 2) DPROR=VALUE 
IFCI.EQ. 3) KMAN=VALUE 
IFCI.EQ. 4) KTANK=VALUE 
IFCI.EQ. 5) LFLOW=VALUE 
IFCI.EQ. 6) PCHMB=VALUE 
IFCI.EQ. 7) TFLOW=VALUE 
IFCI.EQ. 8) VOL=VALUE 
IFCI.EQ. 9) VOLMF=VALUE 
GO TO 25 
ENDIF 

28 CONTINUE 

A=SQRT ( GRAV* KTANK/DENS ) 


B - 36 



CTANK=DENS*VOL/KTANK 

CMAN=DENS*VOLMF/KMAN 

PMRAT=PCHMB/TFLOW 

29 CONTINUE 
ICHG=0 

IF(RSPON . EQ. 4) GO TO 30 

WRITE(*,*) ’ Do you wish to change the pipe layout? ’ 

READ(* , ’ (A) ’ )ANS 

IF(ANS.NE. ’Y’ .AND.ANS.NE. ’ y’ ) GO TO 36 

WRITE(*,*)’ Do you wish to change all of the pipe segments?’ 
READ(*, ’ (A) ’ )ANS 

IF(ANS.NE. ’Y’. AND.ANS.NE. ’ y * ) THEN 
ICHG= 1 
GO TO 30 
ENDIF 
SPLIT=1.0 
L0PEND= 1 

WRITE(* , ’ (A\) ’ ) ’ How many segments is the pipe broken into? ’ 
READ(* , *)SEGMN 

30 CONTINUE 

WRITE(12,*)’ NEW PIPE LAYOUT’ 

WRITEC12,*)’ STATUS LENGTH AREA DIAMETER’ 

1=0 

ISEGMN=SEGMN 
DO 35 11=1 , SEGMN 
1 = 1+1 

IF(ICHG.EQ.l) THEN 
I F ( SECTN ( I ) . EQ. 0) THEN 
WRITE ( * , 4) PIPE2 (I) .PIPE 1(1) 

ELSEIF(SECTN(I).EQ.l) THEN 
WRITE(* , 5 ) PI PE2 (I),PIPE1(I) 

ELSEIF(SECTN( I ) . EQ. 2 ) THEN 
WRITE(*,16)PIPE1(I), PIPE2 ( I ) 

ELSEIF(SECTN( I ) . EQ. 3 ) THEN 
WRITE (*, 13)PIPE1(I) , PIPE2 ( I ) 

ELSEI F( SECTN d) . EQ. 4) THEN 
WRITE (* f 14)PIPE1(I) , P I PE2 ( I ) , PIPE3(I ) 

ELSEI F( SECTN d ) . EQ. 5) THEN 
WRITE(*, 15)PIPE1(I) ,PIPE2(I) ,PIPE3(I) 

ELSEI F( SECTN (I ) . EQ. 6) THEN 

WRITE(*,12)PIPEHI), PIPE2(I ) , PIPE3( I ) , PIPE4(I ) , PIPE5(I ) 
ELSEI F( SECTN (I ) . EQ. 9) THEN 
WRITE(*, ll)INT(PIPE3d)),PIPE2(I),PIPEl(I) 

ENDIF 

WRITE(*,*)’ You may keep (K), modify (Y), delete (D),’, 

* ’ add before (B), or add after (A)?’ 

READ(* , ’ (A) ’ )ANS 

IF(ANS.EQ. ’A’ .OR. ANS. EQ. ’a’) THEN 
1 = 1+1 

DO 31 III=ISEGMN ,1,-1 
PIPE1 ( III+l )=PIPE1 C III ) 

PIPE2(III+1 )=PIPE2(III) 
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PIPE3( III+l )=PIPE3( III ) 

PIPE4( III+l )=PIPE4( III ) 

PIPE5( III+1)=PIPE5(III) 

L(III+1)=L(III) 

DIA( III+l )=DIA( II I ) 

AREA( III+l )=AREA( III ) 

PCAP( III+l )=PCAP( III ) 

PIND( III+l )= PI ND( III) 

SECTN( III+l )=SECTN( III ) 

31 CONTINUE 

ISEGMN=ISEGMN+1 
GO TO 34 

ELSEIF(ANS. EQ. ’B’ .OR. ANS. EQ. ’b’ ) THEN 
DO 32 III=ISEGMN, I , -1 
PIPE1(III+1)=PIPE1(III) 

PIPE2( III+l )=PIPE2( III ) 

PIPE3( III+l )=PIPE3 ( III ) 

PI PE4( III+l )=PIPE4( III ) 

PIPE5( III+l )=PIPE5( III) 

L( III+l ) = L ( III ) 

DIA( III+l )=DIA( III ) 

AREA( III+l )=AREA( I II) 

PCAP(III+1 )=PCAP(III) 

PIND(III+1)=PIND(III) 

SECTN(III+1 )=SECTN(III ) 

32 CONTINUE 

ISEGMN=ISEGMN+1 
GO TO 34 

ELSEIF(ANS.EQ. ’ D ’ . OR . ANS . EQ. ’d’) THEN 
DO 33 I I I = I , ISEGMN 
PI PE 1 ( III )= PI PEI (III+l) 

PIPE2 C III ) = PIPE2 (III+l ) 

PIPE3( III )=PIPE3( III+l) 

PIPE4( III )=PIPE4( III+l) 

PIPE5 ( III )=PIPE5( III+l ) 

L(III)=L(III+1) 

DIA( III )=DIA( III+l ) 

AREA(III )=AREA( III+l ) 

PCAP ( I I I ) = PCAP (III+l) 

PIND( III )=PIND( III+l) 

SECTN( I II )=SECTN( III+l ) 

33 CONTINUE 

1 = 1-1 

ISEGMN=ISEGMN-1 
GO TO 35 

ELSEIF(ANS. NE. ’ Y ’ . AND. ANS. NE. ’ y ’ ) THEN 
GO TO 35 

ENDIF 

ENDIF 

34 CONTINUE 

WRITER,*)’ Specify 0 for BEND, 1 for STRAIGHT pipe,’ 

WRITE(*,*) ’ 2 for INLINE ACCUH. , 3 for TUNED STUB,’ 
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WRITE(*,*)’ 4 for HELMHOLTZ RES., 5 for PARALLEL RES.’ 

WRITE( * , * ) ’ 6 for PUMP, 9 for SPLIT’ 

READ(*,*) SECT 

IF (SECT . LT . 0 . OR. SECT . GT . 6 . AND. SECT . NE. 9) GO TO 34 
SECTN(I )=SECT 
IF(SECT.EQ.O) THEN 
C BEND IN PIPE 

WRITE(*,*)’ RADIUS of bend along CL (ft), ANGLE of bend (deg),’ 
WRITE(*,*)’ DIAMETER (ft), and LENGTH (ft) beyond bend of pipe’ 
READ(* , *)PIPE1(I ) , PIPE2( I ) , PIPE3(I) , PIPE4( I ) 

CALL BENDS (PI PEI ( I ) , PIPE2 ( I ) , PIPE3(I ) , PIPE4( I ) , VALUE , DIME ) 
AREAB=0. 785398*DIME**2 
L ( I )=VALUE 
AREA( I )=AREAB 
DIA(I )=DIME 
PIPE5( I )=0 . 0 
ELSEIF(SECT.EQ.l) THEN 
C STRAIGHT SECTION 

WRITER,*)’ Specify LENGTH (ft) and DIAMETER (ft) of segment’ 
READ(*,*) PIPEl(I) ,PIPE2(I) 

VALUE=PIPE1 ( I ) 

0IME=PIPE2(I ) 

PIPE3(I)=0.0 

PIPE4( I )=0 . 0 

PIPE5(I)=0.0 

AREAB=0. 785398*DIME**2 

L( I )=VALUE 

AREA( I )=AREAB 

DIA(I )=DIME 

ELSEIF(SECT . EQ. 2 ) THEN 
C INLINE ACCUMULATOR 

WRITE(*,*)’ Specify LENGTH (ft) & DIAMETER (ft) of accumulator ’ 
READ(*,*) PIPEl(I) ,PIPE2(I) 

L ( I ) = PIPE1 ( I ) 

DIA(I)=PIPE2(I) 

AREA( I )=0 . 25*PI*PIPE2 ( I )**2 

PCAP(I)=DENS*0.785398*L(I)*DIA(I)**2*PMRAT/AVGK 
PIPE3 ( I )=0 . 0 
PIPE4( I )=0 . 0 
PIPE5 ( I )=0 . 0 
ELSEIF(SECT. EQ. 3) THEN 
C TUNED STUB ACCUMULATOR 

WRITE(*,*)’ Specify LENGTH (ft) & DIAMETER (ft) of tuned stub’ 
READ(*,*)PIPE1(I) ,PIPE2(I) 

L(I)=PIPE1(I) 

DIA(I)=PIPE2(I) 

AREA(I)=0.25*PI*PIPE2(I)**2 

PCAP ( I ) =DENS*L ( I ) *AREA ( I )*PMRAT/AVGK 

PIND( I )=L(I )/ (AREA(I )*GRAV*PMRAT ) 

PIPE3(I )=0 . 0 
PIPE4( I )=0 . 0 
PIPES ( I )=0 . 0 
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ELSE I F ( SECT . EQ. 4) THEN 

HELMHOLTZ RESONATOR ACCUMULATOR 

WRITER,*)’ Specify LENGTH (ft), DIAMETER (ft) , VOLUME (ft~3)\ 

’ of Helmholtz Resonator’ 

READ(* , * )PIPE1 (I ) , PIPE2( I ) , PIPE3(I ) 

L( I )=PIPE1 ( I ) 

DIA(I)=PIPE2(I) 

AREA(I)=PIPE3(I) 

PCAP( I )=0ENS*L ( I ) *AREA( I )*PMRAT/AVGK 
PIND(I)=L(I)/(0. 25*PI*DIA( I ) **2*GRAV*PMRAT ) 

PIPE4(I)=0.0 
PIPE5(I)=0.0 
ELSEIF(SECT . EQ. 5 ) THEN 

PARALLEL RESONATOR ACCUMULATOR 

WRITE(*,*)’ Specify LENGTH (ft), DIAMETER (ft) , VOLUME (ft~3)\ 
of Parallel Resonator’ 

READ(* , *)PIPE1(I), PIPE2 (I),PIPE3(I) 

L( I )=PIPE1 ( I ) 

DIA(I)=PIPE2(I) 

AREA( I )=PIPE3 ( I ) 

PCAP( I ) =DENS*L ( I ) *AREA( I )*PMRAT/AVGK 
PIND(I)=L(I)/(0.25*PI*DIA(I)**2*GRAV*PMRAT) 

PIPE4(I )=0 . 0 
PIPE5(I)sO.O 
ELSEIF(SECT. EQ. 6) THEN 
PUMP 

WRITE( * , *) ’ Specify LENGTH (ft), DIAMETER (ft) , dp/dm, CAP.’, 

’ & IND. of pump’ 

READ(*,*)PIPE1(I) ,PIPE2(I),PIPE3(I),PIPE4(I),PIPE5(I) 
L(I)=PIPE1(I) 

DIA( I )=PIPE2 ( I ) 

AREA(I ) = PIPE3( I ) 

PCAP( I )=PIPE4( I ) *PMRAT 
PIND( I )=PIPE5 ( I )/PMRAT 
ELSEIF(SECTN( I ) . EQ. 9 ) THEN 
SPLIT PIPE 

WRITER, *)’ Specify LENGTH (ft), DIAMETER (ft), and no. of’, 

’ segments’ 

READ(*,*) PIPEl(I) ,PIPE2(I) ,PIPE3(I) 

VALUE=PIPE1 (I ) 

DIME=PIPE2(I) 

SPLIT=PIPE3( I ) 

WRITE(*, ’ (A, 13) ’ ) ’ Maximun no. of iterations is set at ’.LOPOLD 
WRITE(*, ’ (A\) ’ ) ’ Do you wish to change it? ’ 

READ(* , ’ (A) ’ )ANS 

IF(ANS. EQ. ’ Y’ .OR. ANS. EQ. ’y’ ) THEN 
WRITE(* , ’ (A\) ’ ) ’ Enter maximum no. of iterations ’ 

READ(* , *)LOPOLD 
ENDIF 

LOPEND=LOPOLD 
AREAB=0. 785398*DIME**2 
L(I)=VALUE 



AREA(I)=AREAB 
DIA(I)=DIME 
PIPE4( I )=0 . 0 
PIPE5(I)=0.0 
ENDIF 

WRITE ( 12 , 3 )SECTN( I ) , L ( I ) , AREA ( I ) , DIA( I ) 

35 CONTINUE 
SEGMN=ISEGMN 

36 CONTINUE 

WRITE(*, ’ (A\) ’ ) ’ Do you wish to save these changes? Y or N ’ 

READ(* , ’ (A) ’ )ANS 

IF(ANS. NE. ’Y’ .AND.ANS.NE. ’y’ ) RETURN 

WRITE(*, ’ (A,A,A\) ’ ) ’ Do you wish to use file ’,NAMLIN,’? Y or N ’ 
READ( * , ’ (A) ’ )ANS 

IF(ANS. NE. ’Y’ .AND.ANS.NE. ’ y ’ ) THEN 
WRITE(* , ’ (A\) ’ ) ’ Enter name of file to use ’ 

READ(*, ’ (A) ’ )NAMLIN 
CL0SE(UNIT=11) 

0PEN(UNIT=11 , FILE=NAMLIN) 

ELSE 

WRITE(*, ’ (A,A,A\) ’ ) ’ Do you wish to rewind ’.NAMLIN,’? Y or N ’ 
READ(*, ’ (A) ’ )ANS 

IF(ANS.EQ. ’Y’.OR.ANS.EQ. ’y’) REWIND 11 
ENDIF 

WRITE(11 , ’ (A) ’ )TITLF 
WRITE( 11 , 1 )VOL 
WRITE(11 , 1)LFL0W 
WRITE(11,1)KTANK 
WRITE(11,1)DENS 
WRITEdl , 1 )TFL0W 
WRITE (11 , 1 )VOLMF 
WRITE(11, 1)KMAN 
WRITE(11 ,1)PCHMB 
WRITE(11, l)DPROR 
WRITE(11, 2)SEGMN 

WRITE (1 1,2) (SECTN (I),PIPE1(I), PIPE2( I ),PIPE3(I),PIPE4(I), PIPE5( I ) , 
* 1=1 , SEGMN) 

RETURN 

END 

SUBROUTINE NEXPT(WN , MAGI ) 

C Supervises plot of admittance while computing 

COMMON /WCAPAS/IFRST 
REAL MAGI ,X(2),Y(2) 

X(2)=WN 

Y(2)=MAG1 

IF(IFRST.NE.O) CALL QTABL(1 , 2 ,X, Y) 

X(1 )=WN 
Y ( 1 )=MAG1 
IFRST=1 
RETURN 
END 

SUBROUTINE PIPPLOT (SEGMN , SECTN , PIPE1 , PIPE2 , PIPE3 , PIPE4 ) 
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C Supervises plot of piping layout 

COMMON /ARCCON/XC , YC , RAD , ANG , ANGLE 

COMMON /PIPPXY/X , XH , XL , Y , YH , YL , XMIN , XMAX , YMIN , YMAX , S INA , COSA 
EXTERNAL XFUN.YFUN 

INTEGERS SEGMN,SECTN(75) , ITYPE(200) 

REAL PIPE1(75) ,PIPE2(75) ,PIPE3(75) ,PIPE4(75) 

REAL POINT (8,200),XP(2),YP(2) 

ANG=0 . 0 
ANGLE=0. 0 
COSA=l . 0 
SINA=0 . 0 
X=0.0 
XH=0. 0 
XL=0. 0 
Y=0. 0 

IF(SECTN(1) . EQ.O) THEN 
YH=Y+0.5*PIPE3(1) 

YL=Y-0.5*PIPE3(1) 

ELSEIF(SECTN( 1 ) . GE. 3 . AND. SECTN( 1 ) . LE. 5 ) THEN 
IF(SECTN(2) . EQ.O) THEN 
YH=Y+0.5*PIPE3(2) 

YL=Y-0.5*PIPE3(2) 

ELSE 

YH=Y+0. 5*PIPE2(2) 

YL=Y-0 . 5*PIPE2 (2 ) 

ENOIF 

ELSE 

YH=Y+0 . 5*PIPE2 ( 1 ) 

YL=Y-0.5*PIPE2(1) 

ENDIF 
J = 0 

XMIN=0 . 0 
XMAX=0 . 0 

YMIN=AMIN1 ( Y , YL , YH) 

YMAX=AMAX1(Y, YL, YH) 

DO 21 I=1,SEGMN 
IF(SECTN(I) . EQ.O) THEN 
C BEND 

CALL BNSECT( J , ITYPE , POINT , PIPE1 ( I ) , PIPE2( I ),PIPE3(I),PIPE4(I)) 
ELSEIF(SECTN( I ) . EQ. 1 . OR. SECTN( I ) . EQ. 9) THEN 
C STRAIGHT SECTION 

CALL STSECT(J, ITYPE, POINT, PIPE1 ( I ) , PIPE2 ( I ) ) 

ELSEIF(SECTN( I ) . EQ. 2) THEN 
C INLINE ACCUMULATOR 

CALL STSECT(J, ITYPE, POINT, PIPEl(I) ,PIPE2(I) ) 

ELSEIF(SECTN( I ) . EQ. 3) THEN 
C TUNED STUB ACCUMULATOR 

CALL TSSECT(J, ITYPE, POINT, PIPEK I ),PIPE2(I)) 

ELSEIF(SECTN(I ) . EQ. 4) THEN 
C HELMHOLTZ RESONATOR 

CALL HHSECT ( J , ITYPE, POINT , PI PEI ( I ) , PIPE2(I ) , PIPE3 ( I ) ) 
ELSEIF(SECTN(I ) . EQ. 5) THEN 


B - 42 


C PARALLEL RESONATOR 

CALL PLSECT ( J , ITYPE , POINT , PIPE1 ( I ) , PIPE2 ( I ) , PIPE3 ( I ) ) 
ELSEIF(SECTN( I ) . EQ. 6) THEN 
C PUMP 

CALL STSECT ( J , ITYPE , POINT , PIPE1 ( I ) , PIPE2 ( I ) ) 

ENDIF 

21 CONTINUE 

XRANGE=XMAX-XMIN 

YRANGE=YMAX-YMIN 

XMIN=XMIN-0 . 05*XRANGE 

XMAX=XMAX+0 . 05*XRANGE 

YMIN=YMIN-0. 05*YRANGE 

YMAX=YMAX+0 . 05*YRANGE 

CALL UPPERW ( XMI N , YM I N , XMAX , YMAX ) 

DO 24 1 = 1, J 

I F( ITYPE (I ) . EQ. 0) THEN 
C BEND 

XC=POINT (1,1) 

YC=POINT (2,1) 

Xl=POINT (3,1) 

Y1=P0INT(4,I) 

RAD= POINT (5,1) 

IF(Xl.GT.Yl) THEN 
Xl=3. 14159+X1 
Yl=3 . 14159+Y1 

CALL QCURV(XFUN , YFUN , Y1 , XI ) 

ELSE 

CALL QCURV(XFUN , YFUN ,X1 , Y1 ) 

ENDIF 

ELSE 

C ALL EXCEPT BEND 

XO=POINT(1,I) 

YO=POINT (2,1) 

X1=P0INT (3,1) 

Y1=P0INT(4, I) 

X2=P0INT (5,1) 

Y2=P0INT (6,1) 

X3=P0INT (7,1) 

Y3=P0INT (8,1) 

XP(1)=X0 
YP( 1 )=Y0 
XP(2 )=X1 
YP(2)=Y1 

CALL QTABL ( 1 , 2 ,XP , YP) 

XP( 1)=X2 
YP( 1 )=Y2 
XP(2)=X3 
YP(2)=Y3 

CALL QTABL( 1 , 2 ,XP , YP) 

XP(1)=X0 
YP( 1 )=Y0 
XP(2)=X2 
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YP( 2 ) = Y2 

CALL QTABL ( 1 , 2 , XP , YP) 

XP(1)=X1 
YP(1)=Y1 
XP(2)=X3 
YP( 2 )=Y3 

CALL QTABL ( 1 , 2 ,XP , YP) 

ENDIF 

24 CONTINUE 
RETURN 
END 

SUBROUTINE PLOTSU ( X , Y , Z , XF , YF , ZF , JPTS , IPTS , IXMAX T IYMAX ) 

C Supervises the surface plot 

CHARACTERS TITLE 
CHARACTERS TITLF 
INTEGERS IHR , IMIN , IYR , IMON , IDAY 
CHARACTERS AP 

COMMON /WCATIT/TITLE, TITLF, IHR, IMIN.AP, IYR, IMON, IDAY 
COMMON /FACTOR/SFAC 
INTEGER*4 IXMAX, IYMAX 

REAL XF( IXMAX) , YF( IYMAX ) , ZF( IXMAX , IYMAX) 

REAL X( IPTS, JPTS), Y( IPTS, JPTS) ,Z( IPTS, JPTS) 

INTEGERS IWRK1(640),IWRK2(640) 

CHARACTER* 1 ANS 
CHARACTERS LEGEND 
CHARACTER*58 LEGENDR , LEGENDH 

DATA LEGEND/’ Pressure Transfer Function = f(freq, distance) ’/ 

DATA LEGENDR/’ Pressure Transfer Function = f (freq( rad/sec) ,distanc 
*e(ft) ) ’/ 

DATA LEGENDH/’ Pressure Transfer Function = f (f req(Hertz) .distance 
*(ft)) ’/ 

DATA ASPECT/1.35/ 

DATA ICOLR/4/, IFIL/3/ , ILIN/1/ 

1 FORMAT ( ’ Current view is PHI =’,F8.3,’ THETA =’,F8.3) 

2 FORMAT ( ’ Current BACKGROUD COLOR = ’,12,’ LINE COLOR = ’,12, 

* ’ FILL COLOR = ’,12) 

CALL QRMODE ( MODET , NCOLT ) 

CALL QVIDBD(IBOARD) 

IF(IBOARD. LT. l.OR. IBOARD.GT. 3) THEN 
WRITE(*,*)’ Graphics board not installed!’ 

RETURN 

ENDIF 

IF(IBOARD.EQ. 1) MODE=6 
IF(IBOARD. EQ.2) MODE=16 
IF(IBOARD. EQ. 3) MODE=18 
IWIRE=0 

IF(IBOARD.NE. 1) THEN 

WRITE(*, ’ (A\) ’ ) ’ Do you want a wire-frame drawing? ’ 

READ(* , ’ (A) ’ )ANS 

IF(ANS.EQ. ’ Y’ . OR. ANS. EQ. ’ y ’ ) IWIRE=1 
ENDIF 

XMIN=XF(1) 
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XMAX=XF( IPTS ) 

YMIN=YF(1) 

YMAX=YF(JPTS) 

ZMIN=ZF( 1 , 1 ) 

ZMAX=ZF(1 , 1 ) 

DO 20 J=1 , JPTS 
DO 20 1=1, IPTS 

IF( ZMIN. GT.ZF(I,J)) ZMIN=ZF(I,J) 

IF(ZMAX. LT . ZF( I , J ) ) ZMAX=ZF(I,J) 

20 CONTINUE 
YLEN=YF(JPTS)-YF( 1 ) 

XLEN=XF(IPTS)-XF( 1 ) 

ZLEN=ZMAX-ZMIN 

XYZLEN=AMAX1 (XLEN, YLEN , ZLEN) 

XFAC=XYZLEN/XLEN 
XINV=1 . O/XFAC 
YFAC=XYZLEN/YLEN 
YINV= 1 . O/YFAC 
ZFAC=XYZLEN/ZLEN 
ZINV=1 . O/ZFAC 
DO 21 J=1 , JPTS 
DO 21 1=1, IPTS 
X( I , J )=XF( I )*XFAC 
Y ( I , J )=YF( J )*YFAC 
Z(I,J)=ZF(I , J)*ZFAC 

21 CONTINUE 
XMIN=XMIN*XFAC 
XMAX=XMAX*XFAC 
YMIN=YMIN*YFAC 
YMAX=YMAX*YFAC 
ZMIN=ZMIN*ZFAC 
ZMAX=ZMAX*ZFAC 
XMAJ=0. 2*(XMAX-XMIN) 

YMAJ=0 . 2* ( YMAX-YMIN ) 

ZMAJ=0.2*(ZMAX-ZMIN) 

P=-45 . 0 

T=30. 0 

CALL Q3DR0T(X,Y,Z, IPTS, JPTS, P,T) 

22 CONTINUE 

CALL QSMODE(MODE) 

IF(IBOARD.NE.l) CALL QPREG(0, ICOLR) 

CALL WINDOW( MODE , ASPECT , XMIN , XMAX , YMIN, YMAX , ZMIN , ZMAX ) 
CALL Q3DXAX(XMIN, XMAX, XMAJ, 0,-1, 2, YMIN, YMAX, ZMIN, XINV) 
CALL Q3DYAX (YMIN, YMAX , YMAJ , 0 , - 1 , 2 , XMAX , XMIN , ZMIN , YI NV ) 
CALL Q3DZAX(ZMIN, ZMAX, ZMAJ, 0,-1, 2, XMIN, YMIN, ZINV) 
IF(MODE. EQ. 6) THEN 
CALL QPTXT (40, TITLE, 7, 17, 23) 

CALL QPTXT(45, LEGEND, 7, 15,22) 

ELSEIF(MODE. EQ. 16) THEN 
CALL QPTXT (40 .TITLE , 7,17,23) 

IF(SFAC.EQ.l.O) THEN 
CALL QPTXT ( 58 , LEGENDR ,7,8,22) 
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ELSE 

CALL QPTXT ( 58 , LEGENDH ,7,8,22) 

ENDIF 

ELSE 

CALL QPTXT(40, TITLE, 7, 17,27) 

IF(SFAC.EQ.l.O) THEN 
CALL QPTXT ( 58 , LEGENDR ,7,8,26) 

ELSE 

CALL QPTXT (58 , LEGENDH, 7 ,8,26) 

ENDIF 

ENDIF 

IF(IBOARD. EQ, l.OR. I WIRE. EQ. 1) THEN 
CALL Q3DSTK(X , Y, IPTS, JPTS, IWRK1 , IWRK2 ,640,1) 

ELSE 

CALL Q3DFIL(X,Y, IPTS, JPTS, IFIL.ILIN) 

ENDIF 

23 CONTINUE 

CALL QONKEY(IKEY) 

IF(IKEY.EQ.O) GO TO 23 
CALL QINKEY ( IEXTEN , IKEY) 

IF(IKEY . EQ. 80.0R. I KEY. EQ. 1 12 ) CALL QPSCRN 
CALL QSMODE(MODET) 

25 CONTINUE 
IGO=0 

WRITER, 1)P,T 

WRITEC* , ’ (A\) ’ ) ’ Do you wish another view? ’ 

READ(* , ’ (A) ’ )ANS 

IFCANS.EQ. ’Y’.OR.ANS.EQ. ’y’) THEN 

WRITEC*, ’ (A\) ’ ) ’ Enter new viewing angles PHI & THETA. ’ 
READ(*,*)P,T 

CALL Q3DINV(X,Y,Z, IPTS, JPTS) 

CALL Q3DR0T(X,Y,Z, IPTS, JPTS, P,T) 

IGO= 1 
ENDIF 

IF(IBOARD.NE.l) THEN 
WRITEC * , 2 ) ICOLR , ILIN , IFIL 

WRITEC*, ’ (A\) ’ ) ’ Do you wish another color? ’ 

READ(* , ’ (A) ’ )ANS 

IFCANS.EQ. ’Y’.OR.ANS.EQ. ’y’) THEN 

WRITEC*,*)’ Enter color number (0-63) for BACKGROUND, LINE, 
* and FILL ’ 

WRITEC*, *)’ 4,1,3 will give the default colors ’ 

WRITE(*, ’ (A\) ’ ) ’ 0,7,0 will give black & white ’ 

READ(*,*)ICOLR, ILIN, IFIL 
IGO=l 
ENDIF 
IWR=0 

IF(IWIRE.EQ.O) THEN 

WRITE(*, ’ (A\) ’ ) ’ Do you want a wire-frame drawing? ’ 

READ(* , ’ (A) ’ ) ANS 

IFCANS.EQ. ’Y’.OR.ANS.EQ. ’y’) THEN 
IWR= 1 
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IG0=1 

ENDIF 

ELSE 

WRITE(* , ’ (A\) ’ ) ’ Do you want a filled drawing? ’ 

READ(* , ’ (A) ’ )ANS 

IF(ANS. EQ. ’ Y’ .OR. ANS. EQ. ’y’) THEN 
IWR=2 
IGO=l 
ENDIF 
ENDIF 

IF(IWR.EQ.l) IWIRE= 1 
IFCIWR.EQ.2) IWIRE=0 
ENDIF 

IF(IGO.NE.O) GO TO 22 

RETURN 

END 

SUBROUTINE PLSECT ( J , ITYPE , POINT , LEN , DIA , VOL ) 

C Computes plot coordinates for parallel resonator 

COMMON /PIPPXY/X , XH , XL , Y , YH , YL , XMIN , XMAX , YMIN , YMAX , SINA , COSA 
COMMON /ARCCON/XC , YC , RAD , ANG , ANGLE 
REAL LEN , POINT (8 , 200 ) 

INTEGER*2 ITYPE(200) 

XOLD=X 

XHOLD=XH 

XLOLD=XL 

YOLD=Y 

YHOLD=YH 

YLOLD=YL 

ANGOLD=ANG 

ANGSAV=ANGLE 

SINOLD=SINA 

COSOLD=COSA 

DIAM=SQRT ( (XH-XL) **2+( YH-YL ) **2 ) 

CALL STSECT ( J , ITYPE , POINT , DIA, DIAM) 

XC=0 . 5* (XHOLD+XH) 

XHC=XHOLD 

XLC=XL 

YC=0.5*(YHOLD+YH) 

YHC=YHOLD 

YLC=YL 

PLEN=LEN-2 . 0*DIA 

PDIA= ( VOL-2 . 0*DIA*DIAM)/PLEN 

CALL STSECT( J , ITYPE , POINT , PLEN , PDIA) 

CALL STSECT (J, ITYPE, POINT, DIA, DIAM) 

XSAV=X 

XHSAV=XH 

XLSAV=XL 

YSAV=Y 

YHSAV=YH 

YLSAV=YL 

S I NA= COSOLD 

COSA=-SINOLD 
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RADIUS=DIA 

TURN=-90 . 0 

SIDE=LEN-5 . 0*DIA 

ANG=ANG+ 1.5708 

ANGLE=ANGLE+90. 0 

X=XC 

Y=YC 

XH=XHC 

XL=XLC 

YH=YHC 

YL=YLC 

CALL BNSECT ( J , ITYPE , POINT , RADIUS , TURN , DIA , DIA ) 

CALL STSECT( J , ITYPE , POINT , SIDE, DIA) 

CALL BNSECT (J , ITYPE , POINT , RADIUS , TURN , DIA , DIA) 

X=XSAV 

Y=YSAV 

XH=XHSAV 

XL=XLSAV 

YH=YHSAV 

YL=YLSAV 

ANG=ANGOLD 

ANGLE=ANGSAV 

SINA=SINOLD 

COSA= COSOLD 

RETURN 

END 

SUBROUTINE PLTCON(X , Y , Z , XF , YF , ZF , JPTS , IPTS , IXMAX , IYMAX) 

C Supervises plot of contour plot 

CHARACTERS TITLE 
CHARACTERS TITLF 
INTEGERS IHR , IMIN , IYR , IMON , I DAY 
CHARACTER*2 AP 

COMMON /WCATIT/TITLE , TITLF , IHR , IMIN , AP , IYR , IMON , IDAY 
COMMON /FACTOR/SFAC 
INTEGERS IXMAX, IYMAX 

REAL XF( IXMAX) , YF( IYMAX ) , ZF( IXMAX , IYMAX) 

REAL X(IPTS),Y(JPTS),Z(IPTS,JPTS) , CONS (10) 

INTEGER*2 LABL(IO) 

DATA ASPECT/1.35/ 

DATA LABL/1, 0,0, 0,1, 0,0, 0,1,0/ 

DATA ICOLR/4/, IFIL/3/ , ILIN/1/ 

2 FORMAT (’ Current BACKGROUD COLOR = ’,12,’ LINE COLOR = ’,12, 
* ’ FILL COLOR = ’,12) 

CALL QRMODE ( MODET , NCOLT ) 

CALL QVIDBD(IBOARD) 

I F ( I BOARD . LT . 1 . OR . I BOARD . GT . 3 ) THEN 
WRITE( * , *) ’ Graphics board not installed!’ 

RETURN 

ENDIF 

I F( I BOARD. EQ. 1) MODE=6 
IF(IBOARD.EQ.2) MODE=16 
IF(IBOARD. EQ. 3) MODE=18 
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XMIN=XF(1) 

XMAX=XF(IPTS) 

YMIN=YF(1) 

YMAX=YF( JPTS) 

ZMIN=ZF( 1 , 1 ) 

ZMAX=ZF( 1,1) 

DO 21 J=1 , JPTS 
Y(J)=YF(J) 

DO 21 1=1 , IPTS 
IF(J.EQ.l) X ( I ) = XF ( I ) 

Z(I,J)=ZF(I, J) 

IF(ZMIN.GT.Z(I , J)) ZMIN=Z(I , J) 

I F ( ZMAX . LT . Z ( I , J ) ) ZMAX=Z(I , J) 

21 CONTINUE 
ZLEN=0.1*(ZMAX-ZMIN) 

DO 22 1=1,9 

CONS( I )= I*ZLEN 

22 CONTINUE 
XMAJ=0.2*(XMAX-XMIN) 

YMAJ=0.2*(YMAX-YMIN) 

20 CONTINUE 

CALL QSMODE(MODE) 

IDEF=2 

IF(IBOARD.NE.l) THEN 
IDEF=2 

CALL QPREG(0 , ICOLR) 

ENDIF 

CALL QCTRDE(MODE, ILIN , IFIL,ILIN,1) 

JCOL1=100 

JCOL2=450 

JR0W1=40 

IF(MODE.EQ.6) JROW1=60 
JROW2=169 

IF(MODE.EQ. 16) JROW2=319 

IF(MODE. EQ. 18) JR0W2=409 

XORG=XMIN 

YORG=YMIN 

YOVERX=l. 0 

IOPT =0 

IF(MODE.NE. 18) THEN 
CALL QPTXT(40,TITLE,7, 17,23) 

ELSE 

CALL QPTXT (40 , TITLE, 7 , 17 , 27) 

ENDIF 

CALL QPLOT ( JCOL1 , JCOL2 , JROW1 , JROW2 , XMIN , XMAX , YMIN, YMAX , 
* XORG.YORG, IOPT, YOVERX, ASPECT) 

CALL QXAXIS(XMIN , XMAX , XMAJ , 0 , -1 , 2 ) 

CALL QYAXIS ( YMI N , YMAX , YMAJ , 0 , - 1 , 2 ) 

IF(SFAC.EQ.l) THEN 
CALL QPTXTA(17, ’ Frequency- rad/sec ’ ,7) 

ELSE 

CALL QPTXTA( 17 , ’ Frequency-Hertz ’,7) 
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ENDIF 

CALL QPTXTD(7, ’X - ft. ’ ,7) 

CALL QCNTOU( ASPECT ,X,Y,Z, CONS , LABL , IPTS , JPTS , 9 , IDEF ) 

23 CONTINUE 

CALL QONKEY(IKEY) 

IF(IKEY.EQ.O) GO TO 23 
CALL QINKEY(IEXTEN, IKEY) 

I F ( I KEY . EQ . 80 . OR . I KEY . EQ . 1 1 2 ) CALL QPSCRN 
CALL QSMODE(MODET) 

IF(IBOARD.NE.l) THEN 
WRITE (*, 2)IC0LR, I LI N, I FI L 

WRITE(* , ’ (A\) ’ ) ’ Do you wish another color? ’ 

READ(* , ’ (A) ’ )ANS 

IF(ANS. EQ. ’Y’.OR.ANS.EQ. ’y’) THEN 

WRITE(*,*)’ Enter color number (0-63) for BACKGROUND, LINE, 
* and FILL ’ 

WRITE(*,*) ’ 4,1,3 will give the default colors ’ 

WRITE(*, ’ (A\) ’ ) ’ 0,7,7 will give black & white ’ 

READ(* , *)ICOLR, I LI N, I FI L 
GO TO 20 
ENDIF 
ENDIF 

25 CONTINUE 
RETURN 
END 

SUBROUTINE SETPLT 

C Sets up the plot environment 

COMMON /WCAPAS/IFRST 

COMMON /NOCOL/MODE , MODET , NTROWS , NTCOLS , NPROWS , NPCOLS 

COMMON / ADMCOL/ADMBAC , ADML I N 

INTEGER ADMBAC,ADMLIN 

CHARACTERS ANS 

DATA ITIM/0/ 

IF(ITIM.EQ.O) THEN 
ITIM=1 
ADMBAC=4 
ADMLIN=1 
ENDIF 

CALL QRMODE(MODET , NCOLT ) 

CALL QVIDBD(IBOARD) 

IF(IBOARD. LT. l.OR. IBOARD.GT. 3) THEN 
WRITE ( * , =► ) * Graphics board not installed!’ 

RETURN 

ENDIF 

IF(IBOARD.EQ.l) THEN 
MODE=6 
NPROWS=200 
NTROWS=25 
ENDIF 

IF(IBOARD. EQ. 2 ) THEN 
MODE=16 
NPROWS=350 
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NTROWS=25 

ENDIF 

IFUB0ARD.EQ.3) THEN 
M0DE=18 
NPROWS=480 
NTROWS=25 
ENDIF 
IFRST=0 
NTCOLS=NCOLT 
NPCOLS=640 
IF(MODE. NE. 6) THEN 

WRITE(*, ’ (A\) ’ ) ’ Do you wish change colors of admittance? ’ 
READ(*, ’ (A) ’ )ANS 

IF(ANS.EQ. ’Y* .OR. ANS. EQ. ’y’) THEN 

WRITE(*,*) ’ Enter no. of background color and no. of line color’ 
WRITE (* , *) ’ 4,1 will give the default colors ’ 

WRITE(*, ’ (A\) ’ ) ’ 0,7 will give black & white ’ 

READ(*, *)ADMBAC,ADMLIN 
ENDIF 
ENDIF 

CALL QSMODE(MODE) 

RETURN 

END 

SUBROUTINE STSECT ( J , ITYPE , POINT , LEN , DIA) 

C Computes plot coordinates for a straight section 

COMMON /PI PPXY/X , XH , XL , Y , YH , YL , XMIN , XMAX , YMIN , YMAX , SINA , COSA 
REAL LEN, POINT(8 , 200 ) 

INTEGERS ITYPE(200) 

J=J+1 

ITYPE ( J ) = 1 

XH=X-0. 5*SINA*DIA 

XL=X+0. 5*SINA*DIA 

YH=Y+0 . 5*COSA*DIA 

YL=Y-0.5*COSA*DIA 

POINT ( 1 , J)=XH 

POINT (2 , J )=YH 

POINT ( 3 , J )=XL 

POINT (4, J )=YL 

X=X+COSA*LEN 

XH=X-0.5*SINA*DIA 

XL=X+0.5*SINA*DIA 

Y=Y+SINA*LEN 

YH=Y+0.5*COSA*DIA 

YL=Y-0.5*COSA*DIA 

POINT ( 5 , J )=XH 

POINT ( 6 , J )=YH 

POINT ( 7 , J )=XL 

POINT(8,J)=YL 

XMIN= AMIN 1(X, XL, XH, XMIN) 

XMAX=AMAX1 (X , XL , XH , XMAX ) 

YMIN=AMIN1(Y,YL, YH, YMIN) 

YMAX=AMAX1 ( Y , YL , YH , YMAX ) 
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RETURN 

END 

SUBROUTINE TSSECT ( J , ITYPE , POINT , LEN, DIA) 

C Computes plot coordinates for a tuned stub 

COMMON /PIPPXY/X , XH , XL , Y , YH , YL , XMIN , XMAX , YMIN , YMAX , SINA , COSA 
REAL LEN , POINT ( 8 , 200 ) 

INTEGER*2 ITYPE(200) 

J=J+1 

ITYPE(J)=1 

DIAM=SQRT ( ( XH-XL ) **2+ ( YH-YL)**2 ) 

XH=X-SINA*(LEN+0.5*DIAM) 

YH=Y+COSA* (LEN+0 . 5*DIAM ) 

POINT ( 1 , J )=XH 
POINT ( 2 , J )=YH 
POINT(3, J)=XL 
POINT (4, J )=YL 
X=X+COSA*DIA 

XH=X-SINA*(LEN+0. 5*DIAM) 

XL=XL+COSA*DIA 

Y=Y+SINA*DIA 

YH=Y+C0SA*(LEN+0. 5*DIAM) 

YL=YL+SINA*OIA 

POINT ( 5 , J )=XH 

POINT (6 , J )=YH 

POINT ( 7 , J )=XL 

POINT (8, J)=YL 

XMIN= AMIN 1(X, XL, XH, XMIN) 

XMAX=AMAX1 (X , XL , XH , XMAX ) 

YMIN=AMIN1(Y,YL,YH,YMIN) 

YMAX=AMAX1 ( Y , YL , YH , YMAX ) 

RETURN 

END 

SUBROUTINE UPPERW(X0 , YO , XI , Y1 ) 

C Sets up upper plotting window 

COMMON /NOCOL/MODE , MODET , NTROWS , NTCOLS , NPROWS , NPCOLS 

COMMON /ADMCOL/ADMBAC, ADMLIN 

INTEGER ADMBAC, ADMLIN 

XMIN=X0 

XMAX=X1 

YMIN=Y0 

YMAX=Y1 

JC0L1=100 

JCOL2=550 

IF (MODE. EQ. 6) THEN 
JR0W1= 100 
JROW2=179 

ELSEIF(MODE. EQ. 16) THEN 
JR0W1=214 
JROW2=309 

ELSEIF(MODE. EQ. 18) THEN 
JR0W1=244 
JROW2=449 
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ENDIF 
XORG=XMIN 
YORG=YMIN 
YOVERX= 1 . 0 
IOPT = 1 
ASPECT =1.35 
YMAXO=YMAX 

CALL QPLOT ( J COL 1 , J COL 2 , J ROW1 , JROW2 , XMIN , XMAX , YMIN, YMAX , 

* XORG,YORG, IOPT, YOVERX, ASPECT) 

IF(IOPT.GE.O) GO TO 21 

IOPT=l 

CHANGE= (YMAX-YMIN)/(YMAXO-YMIN) 

JCOL2= JCOL 1+0. 98*CHANGE*( JCOL2-JCOL1) 

YMAX=YMAXO 

CALL QPLOT ( JCOL 1 , JCOL2 , JROW1 , JROW2 , XMIN , XMAX , YMIN , YMAX , 

* XORG.YORG, IOPT, YOVERX, ASPECT) 

21 CONTINUE 

IF(MODE.NE.6) THEN 
CALL QPREG(0,ADMBAC) 

ENDIF 

CALL QSETUP(0, ADMLIN ,-2 , ADMLIN) 

IF(MODE.NE.18) THEN 
CALL QPTXT(11, ’Pipe Layout ’ , 7 , 35 , 23 ) 

ELSE 

CALL QPTXT(11, ’Pipe Layout ’ , 7 , 35 , 27 ) 

ENDIF 

RETURN 

END 

SUBROUTINE WINDOW ( MODE, XSCALE,XST,XFIN,YST,YFIN,ZST , ZFIN) 

C Sets up window for surface plot 

CALL Q3DWIN(XST,XFIN,YST,YFIN,ZST, ZFIN, XMIN, XMAX, YMIN, YMAX) 

JCOLl= 100 

JCOL2=450 

JROW1=40 

JROW2= 169 

IF(MODE. EQ. 16) JROW2=319 

IF(MODE.EQ. 18) JR0W2=409 

XORG=XMIN 

YORG=YMIN 

YOVERX= 1.0 

IOPT :0 

ASPECT=XSCALE 

CALL QPLOT ( JCOL 1 , JCOL2 , JROW1 , JROW2 , XMIN , XMAX , YMIN , YMAX , 

* XORG.YORG, IOPT, YOVERX, ASPECT) 

RETURN 

END 

FUNCTION XFUN(T) 

C Parametric function for plotting of bends 

COMMON /ARCCON/XC , YC , RAD , ANG .ANGLE 
XFUN=XC+RAD*SIN(T) 

RETURN 

END 
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FUNCTION YFUN(T) 

C Parametric function for plotting of bends 

COMMON /ARCCON/XC , YC , RAD , ANG , ANGLE 
YFUN=YC-RAD*COS ( T ) 

RETURN 

END 

SUBROUTINE ZREAD(NAME, VALUE) 

C Reads input for input modification 

CHARACTER* 1 NAME (8) 

CHARACTER* 1 CARD( 80 ) , PLUS , MI NUS , PERIOD , L E , E , NUMBER (10) 
CHARACTER*! LEND( 3 ) , CEND ( 3 ) , POUND , QUEST , BLK, COMMA 
CHARACTER* 1 LTIT(5) ,CTIT(5) 

CHARACTER*80 DCARD 
EQUIVALENCE (CARD(l) , DCARD) 

DATA PLUS/’ + V, MINUS/’-’/, PERIOD/’. ’/, LE/’e’/, E/’ E 7 , BLK/ ’ ’/ 
DATA NUMBER/ ’0’,’r,’2’,’3’,’4’,’5’,’6’,’7’,’8’,’9’/, COMMA/ ’ , ’ / 
DATA LEND/’e’ , ’n’ , ’d’/ f CEND/’E’ , ’N’ , ’ D’/, POUND/’ #7, QUEST/’ ?’ / 
DATA LTIT/’tVi VtVlVeViCTIT/’TVlVT’.’LVE’/ 

1 FORMAT (A) 

DO 21 1=1,8 
NAMECI )=BLK 

21 CONTINUE 
READ(*, 1)DCARD 
IF(CARD(1).EQ. POUND) THEN 

NAMECI )= POUND 
RETURN 
ENDIF 

IF(CARD(1).EQ. QUEST) THEN 
NAMECI )=QUEST 
RETURN 
ENDIF 

DO 22 1=1,3 

IFCCARDC I ) . NE. LENDC I ) . AND. CARD ( I ) . NE. CENDC I ) ) GO TO 220 
NAMECI )=CEND( I ) 

22 CONTINUE 
RETURN 

220 CONTINUE 

DO 221 1=1,5 

IF(CARD( I).NE.LTIT(I). AND. CARD ( I ) . NE. CTIT(I ) ) GO TO 23 
NAMEC I ) = CTIT ( I ) 

221 CONTINUE 
RETURN 

23 CONTINUE 

DO 24 1=1,8 
II = I 

IF(CARD(I).EQ. BLK. OR. CARDCD.EQ. COMMA) GO TO 25 
NAME(I)=CARD( I ) 

24 CONTINUE 

25 CONTINUE 

DO 26 1=11,80 
ID=I 

IF(CARD(I).NE. BLK. AND. CARDCD.NE. COMMA) GO TO 27 
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26 CONTINUE 
VALUE=0 . 0 

WRITE(*,*)’ No value given, ZERO assumed’ 
RETURN 

27 CONTINUE 
SIGN=1.0 

IF(CARD(ID).EQ. MINUS) THEN 
SIGN=-1.0 

I D= I D+ 1 

ELSEI F ( CARD ( I D ) . EQ . PLUS ) THEN 
ID=ID+1 
ENDIF 
WHOLE=0 . 0 
DO 30 I=ID,80 

II = I 

IF(CARD(I).EQ. PERIOD) GO TO 31 
IF(CARD( I ) . EQ. PLUS) GO TO 36 
IF(CARO(I).EQ. MINUS) GO TO 36 
I F ( CARD ( I ) . EQ. E. OR . CARD ( I ) . EQ. LE) GO TO 35 
DO 28 J = 1 , 10 
JJ=J-1 

IF(CARD( I ) . EQ. NUMBER (J ) ) GO TO 29 

28 CONTINUE 

VALUE=SIGN*WHOLE 

IF(CARD(I) . EQ.BLK) RETURN 

WRITE(*,*)’ Input error, value set to ZERO’ 

VALUE=0. 0 

RETURN 

29 CONTINUE 

WHOLE=WHOLE*10 . 0+JJ 

30 CONTINUE 
VALUE=SIGN*WHOLE 
RETURN 

31 CONTINUE 
ID=II+1 
FRACT=0 . 0 
I COUNT =0 

DO 34 I=ID, 80 
ICOUNT=ICOUNT+l 
II=I 

IF(CARD(I).EQ. PERIOD) THEN 
WRITE(*,*)’ Input error, value set to ZERO’ 
VALUE=0.0 
RETURN 
ENDIF 

IF(CARD( I ) . EQ. PLUS) GO TO 36 
IF(CARD(I).EQ. MINUS) GO TO 36 
IF(CARD( I ) . EQ. E.OR. CARD(I ) . EQ. LE) GO TO 35 
DO 32 J=l,10 
JJ=J-1 

IF(CARD( I ) . EQ. NUMBER( J ) ) GO TO 33 

32 CONTINUE 
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VALUE=SIGN*(WHOLE+FRACT) 

IF(CARDU).EQ.BLK) RETURN 

WRITE (*,*) ’ Input error, value set to ZERO’ 

VALUE=0 . 0 

RETURN 

33 CONTINUE 

FRACT=FRACT+JJ/10.0**ICOUNT 

34 CONTINUE 

VALUE=SIGN*(WHOLE+FRACT) 

RETURN 

35 CONTINUE 
11=11+1 

36 CONTINUE 

VALUE=SIGN*(WHOLE+FRACT) 

SIGN= 1 . 0 

IF(CARD(II).EQ. MINUS) THEN 
SIGN=-1 . 0 
11=11+1 

ELSEIF(CARD( II ) . EQ. PLUS) THEN 
11=11+1 
ENDIF 
WHOLE=0. 0 
DO 39 1=11,80 
DO 37 J=1 , 10 
JJ=J-1 

IF(CARD( I ) . EQ. NUMBER! J ) ) GO TO 38 

37 CONTINUE 

VALUE=VALUE*10 . 0**(SIGN*WHOLE) 

IF(CARD( I) . EQ. BLK) RETURN 

WRITE!*,*)’ Input error, value set to ZERO’ 

VALUE=0 . 0 

RETURN 

38 CONTINUE 

WHOLE= WHOLE* 10 . 0+JJ 

39 CONTINUE 

VALUE=VALUE*10. 0**(SIGN*WHOLE) 

RETURN 

END 
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Append i x C 


Listing of Nyqulst Program 


N YG> 
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PROGRAM NYQ 


C 
C 
C 

C Program to calculate fuel and lox lines admittance 

C as input to routines for a Nyqulst plot 

C 
C 

C Variables In Commons 

C 


c 



BLANK 

c 

SCREEN 

CHAR*22 

screen atrlbutes for plotting 

u 

c 



/ARCCON/ 

c 

xc 

REALM 

x coordinate of curve center 

c 

YC 

REALM 

y coordinate of curve center 

c 

RAD 

REALM 

radius of bend 

c 

ANG 

REALM 

angle of bend In radians 

c 

p 

ANGLE 

REALM 

angle of bend In degrees 

Vs 

c 



/FACTOR/ 

c 

p 

SFAC 

REAL *4 

factor for frequency 

Vs 

c 



/NOCOL/ 

c 

NCOLS 

INTEGERS 

number of text columns 

c 

p 

NMODE 

INTEGER*2 

graphics mode 

Vs 

c 



/PIPPXY/ 

c 

X 

REALM 

x location of current centerline 

c 

XH 

REALM 

x location of current upper pipe 

c 

XL 

REALM 

x location of current lower pipe 

c 

Y 

REALM 

y location of current centerline 

c 

YH 

REALM 

y location of current upper pipe 

c 

YL 

REAL *4 

y location of current lower pipe 

c 

XMIN 

REALM 

minimum x value of piping layout 

c 

XMAX 

REALM 

maximum x value of piping layout 

c 

YMIN 

REALM 

minimum y value of piping layout 

c 

YMAX 

REALM 

maximum y value of piping layout 

c 

SINA 

REALM 

sine of current pipe direction 

c 

p 

COSA 

REALM 

cosine of current pipe direction 

Vs 

c 



/WCAOUT / 

c 

NAMLIN(2) 

CHAR*24 

name of files containing pipe description 

c 

p 

IUNIT 

INTEGER*2 

! unit number of current file (fuel or lox) 

Vs 

c 



/WCAPAS/ 

c 

p 

IFRST 

INTEGER*2 

! flag for admittance plot 

Vs 

c 



/WCATIT/ 

c 

TITLE 

CHARMO 

title for plots 

c 

TITLF 

CHAR*20 

title from pipe file 

c 

IHR 

INTEGER*2 hour code run 

c 

IMIN 

INTEGER*2 minute code run 


C - 2 


c 

AP 

CHAR*2 

AM or PM 

c 

IYR 

INTEGER*2 

yesr code run 

c 

I MON 

INTEGER*2 

month code run 

c 

c 

I DAY 

INTEGER*2 

day code run 

c 



/WORKIT/ 

c 

WORK(12) 

REALM 

EQUIVALENCE(WORK( 1 ) , A) 

c 

A 

REALM 

speed of sound In the fluid (ft/sec) 

c 

CHAN 

REALM 

manifold capacitance 

c 

CTANK 

REALM 

tank capacitance 

c 

DENS 

REALM 

density of fluid (lbrn/ft'S) 

c 

LFLOW 

REALM 

flow rate through pipe (lbm/sec) 

c 

KTANK 

REALM 

bulk modulus of tank (lbf/ft~2) 

c 

KMAN 

REALM 

bulk modulus of manifold (lbf/ft~2) 

c 

TFLOW 

REALM 

total flow rate of engine (lbm/sec) 

c 

VOL 

REALM 

volume of tank (ft" 3) 

c 

VOLMF 

REALM 

volume of manifold (ft"3) 

c 

PCHMB 

REALM 

chamber pressure (lbf/ft"2) 

c 

c 

DPROR 

REALM 

pressure drop across orflces (lbf/ft"2) 

c 

c 

PROGRAM NYQ 



c 

p 

Logic portion of code 


V 

c 

Commons FACTOR 

NOCOL WCAOUT WCATIT 

c 


Local Variables 

c 

AM 

CHAR*2 

’AM’ 

c 

ANS 

CHAR*1 

response to question 

c 

CHOICE 

INTEGERS 

flag for type plot requested 

c 

CSTAR 

REALM 

characteristic rocket velocity (ft/sec) 

c 

DCDR 

REALM 

change in velocity with mixture ratio (ft/sec) 

c 

GF 

COMPLEX*8 

admittance of fuel line looking toward tank 

c 

GOX 

COMPLEX*8 

admittance of lox line looking toward tank 

c 

HFREQ 

REALM 

maximum frequency requested 

c 

I FUEL 

INTEGER*2 

flag Indicating presence of fuel line 

c 

IGONE 

INTEGER*2 

flag for FUEL & LOX routines 

c 

ILOX 

INTEGER*2 

flag Indicating presence of lox line 

c 

ISEC 

INTEGER*2 

second code run 

c 

1100 

INTEGER*2 

hundredth of second code run 

c 

K 

INTEGER*2 

do loop Index 

c 

KW(1001) 

REAL*4 

frequency array 

c 

KlC(lOOl) 

REAL*4 

complex part of K(jw) 

c 

KlR(lOOl) 

REAL*4 

real part of K(jw) 

c 

K2C(1001) 

REAL*4 

complex part of K(jw,Gox) 

c 

K2R(1001) 

REAL*4 

real part of K(jw,Gox) 

c 

K3C(1001) 

REAL*4 

complex part of K(jw,Gf) 

c 

K3R(1001) 

REAL*4 

real part of K(jw,Gf) 

c 

K4C(1001) 

REAL*4 

complex part of K(jw,Gox,Gf) 

c 

K4R(1001) 

REALM 

real part of K(jw,Gox,Gf) 

c 

LFREQ 

REALM 

minimum frequency requested 

c 

NPTS 

INTEGERS 

Intermediate variable 

c 

PM 

CHAR* 2 

’PM’ 
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c 

PTS 

INTEGER*2 

number of frequencies 

c 

PIPEA1(75) 

REALM 

first parameter of fuel pipe description 

c 

PIPEA2(75) 

REALM 

second parameter of fuel pipe description 

c 

PIPEA3(75) 

REALM 

third parameter of fuel pipe description 

c 

PIPEA4(75) 

REALM 

fourth parameter of fuel pipe description 

c 

PIPEB1(75) 

REALM 

first parameter of lox pipe description 

c 

PIPEB2(75) 

REALM 

second parameter of lox pipe description 

c 

PIPEB3(75) 

REALM 

third parameter of lox pipe description 

c 

PIPEB4(75) 

REALM 

fourth parameter of lox pipe description 

c 

RBAR 

REALM 

mixture ratio 

c 

S 

COMPLEX*8 

complex frequency 

c 

SECTNA(75) 

INTEGER*2 

fuel pipe section types 

c 

SECTNB(75) 

INTEGER42 

lox pipe section types 

c 

SEGMNA 

INTEGER*2 

number of fuel pipe sections 

c 

SEGMNB 

INTEGER*2 

number of lox pipe sections 

c 

SSIZE1 

REALM 

parameter to pack frequencies toward low end 

c 

SSIZE2 

REALM 

parameter to pack frequencies toward low end 

c 

SSIZE3 

REALM 

parameter to pack frequencies toward low end 

c 

TAUT 

REALM 

transport lag (sec) 

c 

THETAC 

REALM 

characteristic time constant (sec) 

c 

VARI 

CHAR*24 

name of Input file 

c 

c 

W 

REALM 

oscillatory part of frequency 

c 

c 

SUBROUTINE ADMIT (S , GADM , A , AREA , CHAN , CTANK , DPROR , L , LFLOW , PMRAT , 

c 


SEGMN , SECTN , SPLIT , LOPEND, PCAP, PI ND) 

c 

p 

determines 

admittance 

looking toward tank 

V/ 

c 

Common WCATIT 



c 


Variables 

In Argument List 

c 

A 

REALM 

speed of sound In the fluid (ft/sec) 

c 

AREA(75) 

REALM 

area of pipe section (ft~2) 

c 

CMAN 

REALM 

manifold capacitance 

c 

CTANK 

REAL*4 

tank capacitance 

c 

DPROR 

REALM 

pressure drop across orflces (lbf/ft~2) 

c 

GADM 

COMPLEX*8 

admittance of line looking toward tank 

c 

L ( 75 ) 

REALM 

length of pipe section (ft) 

c 

LFLOW 

REALM 

flow rate through pipe (lbm/sec) 

c 

LOPEND 

INTEGER*2 

maximum number of Iterations for split pipe 

c 

PCAP(75) 

REALM 

capacitance of pipe section 

c 

PIND(75) 

REAL*4 

Inductance of pipe section 

c 

PMRAT 

REALM 

chamber pressure/total mass flow 

c 

S 

COMPLEX*8 

complex frequency 

c 

SECTN(75) 

INTEGER*2 

pipe section types 

c 

SEGMN 

INTEGER*2 

number of pipe sections 

c 

SPLIT 

REAL*4 

number of lines from pipe spilt 

c 


Local Variables 

c 

CAPM 

COMPLEX*8 

Intermediate variable 

c 

CAPN 

COMPLEX»8 

Intermediate variable 

c 

CFAC 

C0MPLEX*8 

intermediate variable 

c 

ERRP 

REAL*4 

error in gain calculation 

c 

G(0: 75) 

COMPLEX»8 

admittance looking toward tank 
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c 

GDIF 

REALM 

distance between new and old admittance 

c 

GOLD ( 0:75) 

COMPLEX*8 

previous admittance calculated 

c 

GRAV 

REALM 

gravitational constant (lbm-ft/lbf-sec" 

c 

G1 

COMPLEX*8 

admittance starting at G(0)+1 

c 

I 

INTEGERS 

do loop index 

c 

IOPEN 

INTEGER*2 

flag indicating If SURF. ERR Is open 

c 

KLOOP 

INTEGER*2 

do loop index 

c 

RHS 

COMPLEX*8 

intermediate variable 

c 

TL 

REALM 

length/speed of sound 

c 

ZG(75) 

COMPLEX*8 

Impedance looking toward engine 

c 

ZGEFF 

COMPLEX*8 

effective impedance for calculations 

c 

ZOEFF 

COMPLEX*8 

effective ZO for calculations 

c 

ZO(75) 

REALM 

characteristic Impedance 

c 

ZOR 

REALM 

Intermediate variable 

c 

ZT(0: 75) 

COMPLEX*8 

Impedance looking toward tank 

c 

c 

ZTOP 

REALM 

Intermediate variable 

c 

c 

SUBROUTINE ALLPT ( WHOLD , GHOLD , PTS , ITYPE ) 

c 

G 

Supervises Nyqulst plot 


c 


Variables In Argument List 

c 

GHOLD(lOOl) 

REALM 

Imaginary part of K() 

c 

ITYPE 

INTEGER*2 

which K( ) 

c 

PTS 

INTEGER*2 

number of values to plot 

c 

WHOLD(lOOl) 

REALM 

real part of K() 

c 


Local Variables 

c 

DUMWIL 

I NT EGER* 2 

Intermediate variable 

c 

I 

INTEGER*2 

do loop Index 

c 

I MAX 

REAL*8 

maximum value of complex part 

c 

IMMIN 

REAL*8 

minimum value of complex part 

c 

RMAX 

REAL*8 

maximum value of real part 

c 

RMIN 

REAL*8 

minimum value of real part 

c 

X 

REAL*8 

x value of point to be plotted 

c 

XY 

CHAR* 16 

Intermediate variable 

c 

Y 

REAL*8 

y value of point to be plotted 


c 

c 

C SUBROUTINE BENDS ( PIPE1 ,PIPE2 ,PIPE3,PIPE4, VALUE, DIME) 

C Computes effective straight pipe for bend 

C 

C Variables in Argument List 

C DIME REALM effective diameter (ft) 

C PIPE1 REALM radius of bend (ft) 

C PIPE2 REALM angle of bend (degrees) 

C PIPE3 REALM diameter of bend (ft) 

C PIPE4 REALM length of end straight segments (ft) 

C VALUE REALM effective length (ft) 

C Local Variables 

C ARBND REALM area of bend 

C AREAB REALM effective area of bend 

C BENDR REALM bend angle In radians 
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c 

GAMMA 

REALM 

Intermediate variable 

c 

INERT 

REALM 

intermediate variable 

c 

INRAO 

REALM 

Inside radius of bend 

c 

LBENO 

REALM 

intermediate variable 

c 

LPRME 

REALM 

Intermediate variable 

c 

NEWLN 

REALM 

Intermediate variable 

c 

OTRAO 

REALM 

outside radius of bend 

c 

RATIO 

REALM 

Intermediate variable 

c 

X 

REALM 

Intermediate variable 

c 

c 

V 

REALM 

Intermediate variable 

c 

c 

SUBROUTINE BNSECT( J , ITYPE, 

POINT , PIPE1 , PIPE2 , PIPE3 , PIPE4) 

c 

p 

Computes 

plot coordinates for a bend 

c 

Commons ARCCON PIPPXY 


c 


Variables 

In Argument List 

c 

ITYPE(200) 

INTEGER*2 

type plot element 

c 

J 

INTEGER*2 

pointer to element 

c 

PIPE1 

REALM 

first parameter of pipe description 

c 

PIPE2 

REALM 

second parameter of pipe description 

c 

PIPE3 

REALM 

third parameter of pipe description 

c 

PIPE4 

REALM 

fourth parameter of pipe description 

c 

POINT (8 , 200) 

REALM 

description of plot element 

c 


Local Variables 

c 

DIA 

REALM 

Intermediate variable 

c 

HOLD 

REALM 

Intermediate variable 

c 

RANG 

REALM 

Intermediate variable 

c 

SLENTH 

REALM 

Intermediate variable 

c 

XO 

REALM 

Intermediate variable 

c 

XI 

REALM 

Intermediate variable 

c 

X2 

REALM 

Intermediate variable 

c 

X3 

REALM 

Intermediate variable 

c 

YO 

REALM 

Intermediate variable 

c 

Y1 

REALM 

Intermediate variable 

c 

Y2 

REALM 

Intermediate variable 

c 

c 

Y3 

REALM 

Intermediate variable 

c 

c 

COMPLEX FUNCTION CCOSH(S) 


c 

p 

Evaluates 

the complex 

hyperbolic cosine 

V 

c 


Variable 

In Argument List 

c 

S 

COMPLEX*8 

complex frequency 

c 


Local Variables 

c 

COSH I 

REALM 

Intermediate variable 

c 

COSHR 

REALM 

Intermediate variable 

c 

LAMDA 

REALM 

real part of complex frequency 

c 

c 

MU 

REALM 

Imaginary part of complex frequency 

c 

c 

COMPLEX FUNCTION CSINH(S) 



C - 6 


C Evaluates the complex hyperbolic sine 

C 


c 


Variable 

in Argument List 

c 

s 

COMPLEXM 

complex frequency 

c 


Local Variables 

c 

LAMDA 

REALM 

real part of complex frequency 

c 

MU 

REALM 

Imaginary part of complex frequency 

c 

SINHI 

REALM 

Intermediate variable 

c 

c 

SINHR 

REALM 

Intermediate variable 

c 

c 

COMPLEX 

FUNCTION CTANH(S) 


c 

Evaluates the complex 1 

hyperbolic tangent 

c 


Variable 

in Argument List 

c 

c 

S 

COMPLEXM 

complex frequency 

c 

c 

SUBROUTINE CURV(A1,A2) 


c 

p 

Draws circular arc 


c 

Common 

ARCCON 


c 


Variables 

in Argument List 

c 

A1 

REALM 

starting angle for arc 

c 

A2 

REALM 

ending angle for arc 

c 


Local Variables 

c 

ANG1 

REALM 

starting angle for arc 

c 

ANG2 

REALM 

ending angle for arc 

c 

DA 

REALM 

Incremental angle for plot 

c 

DTH 

REALM 

total angle to plot 

c 

DUMWIL 

INTEGERM 

Intermediate variable 

c 

I 

INTEGERM 

do loop Index 

c 

N 

INTEGERS 

number of points to plot 

c 

T 

REALM 

current angle 

c 

XP 

REALM 

x location of point to plot 

c 

XY 

CHAR* 16 

Intermediate variable 

c 

c 

YP 

REALM 

y location of point to plot 

c 

c 

SUBROUTINE ENDPLT 


c 

p 

Closes plot routines 


c 


Local Variable 

c 

c 

DUMMY 

INTEGER*2 

Intermediate variable 

c 

c 

LOGICAL 

FUNCTION fourcolorsO 

c 

p 

Determines type of graphics monitor 

c 

Common 

BLANK 


c 


Local Variable 

c 

DUMMY 

I NT EGER* 2 

Intermediate variable 
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c 

c 


c 

SUBROUTINE 

FUEL(S,GF, PIPEA1 

,PIPEA2,PIPEA3,PIPEA4, SEGMNA, SECTNA, IGONE) 

c 

c 

Handles 

fuel piping logic 

V 

c 

Commons WCAOUT WORKIT 


c 


Variables In Argument List 

c 

GF 

COMPLEX*8 

admittance of fuel line looking toward tank 

c 

IGONE 

INTEGER*2 

flag for path to be taken 

c 

SECTNA(75) 

INTEGER*2 

pipe section types 

c 

SEGMNA 

INTEGER*2 

number of pipe sections 

c 

PIPEA1(75) 

REALM 

first parameter of fuel pipe description 

c 

PIPEA2(75) 

REALM 

second parameter of fuel pipe description 

c 

PIPEA3(75) 

REALM 

third parameter of fuel pipe description 

c 

PIPEA4(75) 

REALM 

fourth parameter of fuel pipe description 

c 

S 

COMPLEX*8 

complex frequency 

c 


Local Variables 

c 

A 

REALM 

speed of sound In the fluid (ft/sec) 

c 

ANS 

CHAR*1 

response to question 

c 

AREA(75) 

REALM 

area of pipe section (ft"2) 

c 

CHAN 

REALM 

manifold capacitance 

c 

CTANK 

REALM 

tank capacitance 

c 

DENS 

REALM 

density of fluid (lbm/ft"3) 

c 

DIA(75) 

REALM 

diameter of pipe section (ft) 

c 

DPROR 

REALM 

pressure drop across orflces (lbf/ft"2) 

c 

FUELIN 

CHAR* 24 

name of file containing fuel piping data 

c 

I MORE 

INTEGER*2 

Internal flag 

c 

ISTRT 

INTEGER*2 

Internal flag 

c 

KMAN 

REAL*4 

bulk modulus of manifold (lbf/ft"2) 

c 

KTANK 

REALM 

bulk modulus of tank (lbf/ft"2) 

c 

L(75) 

REALM 

length of pipe section (ft) 

c 

LFLOW 

REALM 

flow rate through pipe (lbm/sec) 

c 

LOPEND 

INTEGER*2 

maximum number of Iterations for split pipe 

c 

LOPOLD 

INTEGER*2 

previous value of LOPEND 

c 

PCAP(75) 

REAL*4 

capacitance of pipe section 

c 

PCHMB 

REAL*4 

chamber pressure (lbf/ft"2) 

c 

PIND(75) 

REAL*4 

Inductance of pipe section 

c 

PIPEA5(75) 

REAL*4 

fifth parameter of fuel pipe description 

c 

PMRAT 

REAL*4 

chamber pressure/total mass flow 

c 

SECTA 

INTEGER*2 

Intermediate variable 

c 

SPLIT 

REALM 

number of lines from pipe split 

c 

TFLOW 

REAL*4 

total flow rate of engine (lbm/sec) 

c 

TITLF 

CHAR*20 

title from fuel file 

c 

VOL 

REAL*4 

volume of tank (ft" 3) 

c 

c 

VOLMF 

REAL*4 

volume of manifold (ft"3) 

c 

c 

SUBROUTINE GINERT(BEND,X,Y) 


c 

c 

Evaluates curve fit of 

Inertance of bends 

c 


Variables in Argument List 

c 

BEND 

REALM 

angle of bend (degrees) 
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C X 
C Y 
C 

C A 
C B(3) 

C 
C 

C SUBROUTINE HHSECT(J , ITYPE, POINT, LEN,DIA, VOL) 

C Computes plot coordinates for Helmholtz resonator 

C 

C Common PIPPXY 
C 

C DIA 
C ITYPE (200) 

C J 
C LEN 

C POINT(8,200) 

C VOL 
C 

C COSOLD 
C DIAM 
C SIDE 
C SINOLD 
C XC 
C XHOLD 
C XLOLD 
C XOLD 
C YC 
C YHOLD 
C YLOLD 
C YOLD 
C 
C 

C SUBROUTINE LABANG ( XMI N , XMAX , YMIN , YMAX ) 

C Labels phase angle plot 

C 


c 

Commons BLANK 

FACTOR NOCOL WCATIT 


c 


Variables 

In Argument List 


c 

XMAX 

REALM 

maximum x value for phase 

angle plot 

c 

XMIN 

REALM 

minimum x value for phase 

angle plot 

c 

YMAX 

REALM 

maximum y value for phase 

angle plot 

c 

YMIN 

REALM 

minimum y value for phase 

angle plot 

c 


Local Variables 


c 

DUMMY 

REALM 

Intermediate variable 


c 

DUMWIL 

INTEGERM 

Intermediate variable 


c 

HI 

REALM 

Intermediate variable 


c 

I 

INTEGERM 

do loop Index 


c 

IDEL 

INTEGERM 

Intermediate variable 


c 

IHI 

INTEGERM 

Intermediate variable 


c 

ILO 

INTEGERM 

Intermediate variable 


c 

ILOC 

INTEGERM 

Intermediate variable 


c 

IMAX 

INTEGERM 

Intermediate variable 



Variables In Argument List 
REALM diameter of opening (ft) 
INTEGERM type plot element 
INTEGERS pointer to element 
REALM length of opening (ft) 
REALM description of plot element 
REALM volume of reservoir (ft" 3) 
Local Variables 

REALM Intermediate variable 

REALM Intermediate variable 

REALM intermediate variable 

REALM Intermediate variable 

REALM Intermediate variable 

REALM Intermediate variable 

REALM Intermediate variable 

REALM Intermediate variable 

REALM Intermediate variable 

REALM Intermediate variable 

REALM Intermediate variable 

REALM Intermediate variable 


REALM ratio of inner to outer radius 

REALM Inertance 

Local Variables 

REALM Intermediate variable 

REALM coefficient array for inertance fit 


C - 9 



c 

ROW 



INTEGERS 

Intermediate variable 

c 

ROWS 



INTEGERS 

Intermediate variable 

c 

s 



CHAR* 4 

Intermediate variable 

c 

XHI 



CHAR*7 

label for x tick marks 

c 

XP 



REAL*8 

x point for plot 

c 

XV 



CHAR* 16 

Intermediate variable 

c 

YHI 



CHAR*6 

’ 180*’ upper phase angle label 

c 

YLO 



CHAR* 6 

’ -180" lower phase angle label 

c 

c 

YP 



REAL*8 

y point for plot 

c 

c 

SUBROUTINE 

LABGAIN (XMIN , XMAX , YMIN , YMAX , ITYPE ) 

c 

p 

Labels 

gain plot 


V 

c 

Commons 

BLANK 

FACTOR NOCOL WCATIT 

c 




Variables 

In Argument List 

c 

ITYPE 



INTEGER*2 

which K() 

c 

XMAX 



REAL*8 

maximum x value for gain plot 

c 

XMIN 



REAL*8 

minimum x value for gain plot 

c 

YMAX 



REAL*8 

maximum y value for gain plot 

c 

YMIN 



REAL*8 

minimum y value for gain plot 

c 




Local Variables 

c 

DUMMY 



REAL*4 

Intermediate variable 

c 

DUMWIL 



I NT EGER* 2 

Intermediate variable 

c 

HI 



REAL*4 

Intermediate variable 

c 

I 



INTEGER*2 

do loop Index 

c 

IDEL 



INTEGER*2 

Intermediate variable 

c 

IHI 



INTEGER*2 

Intermediate variable 

c 

ILO 



INTEGER*2 

Intermediate variable 

c 

ILOC 



INTEGER*2 

intermediate variable 

c 

IMAX 



INTEGER*2 

Intermediate variable 

c 

ROW 



INTEGER*2 

Intermediate variable 

c 

ROWS 



INTEGER*2 

intermediate variable 

c 

S 



CHAR*4 

intermediate variable 

c 

XHI 



CHAR*7 

label for x tick marks 

c 

XP 



REAL*8 

x point for plot 

c 

XY 



CHAR* 16 

intermediate variable 

c 

YHI 



CHAR* 6 

’ 180" upper phase angle label 

c 

YLO 



CHAR*6 

’ -180" lower phase angle label 

c 

c 

YP 



REAL*8 

y point for plot 

c 

c 

SUBROUTINE 

LOWERW(XMIN , XMAX , YMAX , YMIN ) 

c 

c 

Sets 

up 

lower plotting 

window 

w 

c 

Commons 

BLANK 

NOCOL 


c 




Variables 

In Argument List 

c 

XMAX 



REAL*8 

maximum x value for Nyqulst plot 

c 

XMIN 



REAL*8 

minimum x value for Nyqulst plot 

c 

YMAX 



REAL*8 

maximum y value for Nyqulst plot 

c 

YMIN 



REAL*8 

minimum y value for Nyqulst plot 

c 




Local Variables 


C - 10 


c 

COLS 

INTEGER*2 

number of text columns 

c 

DUMMY 

INTEGER*2 

intermediate variable 

c 

ROWS 

INTEGERS 

number of text rows 

c 

XLEN 

REAL*8 

intermediate variable 

c 

XWIDTH 

INTEGER*2 

number of x pixels 

c 

YHEIGHT 

INTEGER*2 

number of y pixels 

c 

c 

YLEN 

REAL*8 

Intermediate variable 

c 

c 

SUBROUTINE LOX(S,GOX,PIPEBl 

, PIPEB2 , PIPEB3 , PIPEB4 , SEGMNB , SECTNB , IGONE ) 

c 

c 

Handles 

lox piping logic 

c 

Commons WCAOUT WORKIT 


c 


Variables In Argument List 

c 

GOX 

COMPLEX*8 

admittance of lox line looking toward tank 

c 

IGONE 

INTEGER*2 

flag for path to be taken 

c 

PIPEB1(75) 

REALM 

first parameter of lox pipe description 

c 

PIPEB2(75) 

REALM 

second parameter of lox pipe description 

c 

PIPEB3(75) 

REALM 

third parameter of lox pipe description 

c 

PIPEB4(75) 

REALM 

fourth parameter of lox pipe description 

c 

S 

COMPLEX*8 

complex frequency 

c 

SECTNB(75) 

INTEGER*2 

pipe section types 

c 

SEGMNB 

INTEGER*2 

number of pipe sections 

c 


Local Variables 

c 

A 

REALM 

speed of sound In the fluid (ft/sec) 

c 

ANS 

CHAR*1 

response to question 

c 

AREA(75) 

REALM 

area of pipe section (ft~2) 

c 

CMAN 

REALM 

manifold capacitance 

c 

CTANK 

REALM 

tank capacitance 

c 

DENS 

REALM 

density of fluid (Ibm/ff'S) 

c 

DIA(75) 

REALM 

diameter of pipe section (ft) 

c 

DPROR 

REALM 

pressure drop across orflces (lbf/ft"2) 

c 

IMORE 

INTEGER*2 

Internal flag 

c 

ISTRT 

INTEGER*2 

Internal flag 

c 

KMAN 

REALM 

bulk modulus of manifold (lbf/ft"2) 

c 

KTANK 

REALM 

bulk modulus of tank (lbf/ft~2) 

c 

1(75) 

REALM 

length of pipe section (ft) 

c 

LFLOW 

REALM 

flow rate through pipe (lbm/sec) 

c 

LOPEND 

INTEGERS 

maximum number of Iterations for split pipe 

c 

LOPOLD 

INTEGER*2 

previous value of LOPEND 

c 

LOXIN 

CHAR* 2 4 

name of file containing lox piping data 

c 

PCAP(75) 

REALM 

capacitance of pipe section 

c 

PCHMB 

REALM 

chamber pressure (lbf/ft~2) 

c 

PIND(75) 

REALM 

Inductance of pipe section 

c 

PIPEB5(75) 

REALM 

fifth parameter of fuel pipe description 

c 

PMRAT 

REALM 

chamber pressure/total mass flow 

c 

SECTB 

INTEGER*2 

Intermediate variable 

c 

SPLIT 

REAL*4 

number of lines from pipe split 

c 

TFLOW 

REAL*4 

total flow rate of engine (lbm/sec) 

c 

TITLO 

CHAR*20 

title from lox file 

c 

VOL 

REAL*4 

volume of tank (ft~3) 

c 

VOLMF 

REALM 

volume of manifold (ft~3) 
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c 

c 

C SUBROUTINE MODI FY ( AREA , DI A , L , PIPE1 , PIPE2 , PIPE3 , PIPE4 , PIPE5 , SECTN, 

C SEGMN , SECT , PIND , PCAP , LOPEND , LOPOLD , SPLIT , PMRAT , R ) 


c 

c 

Allows 

modifications to 

input data 

c 

Commons WCAOUT 

WCATIT WORKIT 

c 



Variables in Argument List 

c 

AREA(75) 


REALM 

area of pipe section (ft~2) 

c 

DIA(75) 


REALM 

diameter of pipe section (ft) 

c 

L(75) 


REALM 

length of pipe section (ft) 

c 

LOPEND 


INTEGERS 

maximum number of Iterations for split pipe 

c 

LOPOLD 


INTEGERS 

previous value of LOPEND 

c 

PCAP(75) 


REALM 

capacitance of pipe section 

c 

PIND(75) 


REALM 

Inductance of pipe section 

c 

PIPE1(75) 


REALM 

first parameter of pipe description 

c 

PIPE2(75) 


REALM 

second parameter of pipe description 

c 

PIPE3(75) 


REALM 

third parameter of pipe description 

c 

PIPE4(75) 


REALM 

fourth parameter of pipe description 

c 

PIPE5(75) 


REALM 

fifth parameter of pipe description 

c 

PMRAT 


REALM 

chamber pressure/total mass flow 

c 

R 


CHARM 

flag for fuel or lox 

c 

SECT 


INTEGER*2 

Intermediate variable 

c 

SECTN (75) 


INTEGERS 

pipe section types 

c 

SEGMN 


INTEGERS 

number of pipe sections 

c 

SPLIT 


REALM 

number of lines from pipe split 

c 



Local Variables 

c 

ANS 


CHARM 

response to question 

c 

AREAS 


REALM 

Intermediate variable 

c 

AVGK 


REALM 

average bulk modulus 

c 

DIME 


REALM 

Intermediate variable 

c 

GRAV 


REALM 

gravitational constant (lbm-ft/lbf-sec~2) 

c 

I 


INTEGERS 

pointer 

c 

II 


INTEGERS 

do loop Index 

c 

III 


INTEGERS 

do loop Index 

c 

ICHG 


INTEGER*2 

change flag 

c 

I SEGMN 


INTEGERS 

Intermediate variable 

c 

NAME 


CHARM 

name of Input variable 

c 

NAMNAM 


INTEGER*2 

flag for fuel or lox 

c 

PI 


REALM 

mathematical constant 

c 

VALUE 


REALM 

value of Input variable 

c 

VARL(9) 


CHARM 

array of variable names (lower case) 

c 

VARU(9) 


CHARM 

array of variable names (upper case) 

c 

c 

VARVAL ( 9 ) 


CHAR*8 

array of variable names for printout 

c 

c 

SUBROUTINE 

NICEGRF (RMIN, RMAX , IMAX , IMMIN , ITYPE ) 

c 

r 

Plots Nyquist curve 


L/ 

c 

Commons BLANK 

FACTOR NOCOL WCATIT 

c 



Variables In Argument List 

c 

I MAX 


REALM 

maximum value of complex part 
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c 

IMMIN 

REAL*8 

minimum value of complex part 

c 

ITYPE 

INTEGERS 

which K() 

c 

RMAX 

REAL*8 

maximum value of real part 

c 

RMIN 

REAL*8 

minimum value of real part 

c 


Local Variables 

c 

DUMMY 

REAL*4 

Intermediate variable 

c 

ROW 

INTEGER*2 

Intermediate variable 

c 

ROWS 

INTEGER*2 

Intermediate variable 

c 

S 

CHAR*4 

Intermediate variable 

c 

XHI 

CHAR*6 

label for maximum x value 

c 

XtO 

CHAR* 6 

label for minimum x value 

c 

XMAX 

REAL*8 

maximum x value 

c 

XMIN 

REAL*8 

minimum x value 

c 

YHI 

CHAR* 6 

label for maximum y value 

c 

YLO 

CHAR*6 

label for minimum y value 

c 

YMAX 

REAL*8 

maximum y value 

c 

c 

YMIN 

REAL*8 

minimum y value 

c 

c 

SUBROUTINE NYQUIS(GF,GOX,S 

, TAUT , CSTAR , RBAR , DCDR , THETAC , K , K 1R , K2R , 

c 


K3R , K4R , 1 

K1C,K2C,K3C,K4C, IFUEL, ILOX) 

c 

c 

Computes the 

• K()’s 


c 


Variables 

In Argument List 

c 

CSTAR 

REAL*4 

characteristic rocket velocity (ft/sec) 

c 

DC DR 

REAL*4 

change In velocity with mixture ratio (ft/sec) 

c 

GF 

COMPLEX*8 

admittance of fuel line looking toward tank 

c 

GOX 

COMPLEX*8 

admittance of lox line looking toward tank 

c 

IFUEL 

INTEGER*2 

flag Indicating presence of fuel line 

c 

ILOX 

INTEGER*2 

flag Indicating presence of lox line 

c 

K 

INTEGER*2 

Index of current Item 

c 

KlC(lOOl) 

REAL*4 

complex part of K(jw) 

c 

KlR(lOOl) 

REAL*4 

real part of K(jw) 

c 

K2C(1001) 

REAL*4 

complex part of K(jw,Gox) 

c 

K2R(1001) 

REAL*4 

real part of K(jw,Gox) 

c 

K3C ( 100 1 ) 

REAL*4 

complex part of KCjw.Gf) 

c 

K3R(1001) 

REAL*4 

real part of K(jw,Gf) 

c 

K4C(1001) 

REAL*4 

complex part of K(jw,Gox,Gf) 

c 

K4R(1001) 

REAL*4 

real part of K(Jw,Gox,Gf) 

c 

RBAR 

REAL*4 

mixture ratio 

c 

S 

COMPLEX*8 

complex frequency 

c 

TAUT 

REAL*4 

transport lag (sec) 

c 

THETAC 

REAL*4 

characteristic time constant (sec) 

c 


Local Variables 

c 

KG1 

COMPLEX*8 

K(jw) 

c 

KG2 

COMPLEX*8 

K( jw,Gox) 

c 

KG3 

C0MPLEX*8 

K( jw,Gf ) 

c 

KG4 

COMPLEX*8 

K( jw,G 0 X,Gf ) 


c 

c 

C SUBROUTINE PIPPLOT(SEGMN,SECTN,PIPEl,PIPE2,PIPE3,PIPE4,ILOX,R) 
C Supervises plot of piping layout 
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c 


c 

Commons ARCCON 

PIPPXY 


c 


Variables 

In Argument List 

c 

ILOX 

I NT EGER* 2 

flag Indicating presence of lox line 

c 

PIPEK75) 

REAL*4 

first parameter of pipe description 

c 

PIPE2(75) 

REAL*4 

second parameter of pipe description 

c 

PIPE3(75) 

REAL*4 

third parameter of pipe description 

c 

PIPE4C75) 

REAL*4 

fourth parameter of pipe description 

c 

R 

CHAR*1 

flag Indicating fuel or lox line 

c 

SECTN(75) 

INTEGER*2 

pipe section types 

c 

SEGMN 

INTEGER*2 

number of pipe sections 

c 


Local Variables 

c 

DUMWIL 

INTEGER*2 

Intermediate variable 

c 

I 

INTEGER*2 

do loop Index 

c 

ITYPE(200) 

INTEGER*2 

type plot element 

c 

J 

INTEGER*2 

pointer to element 

c 

POINT(8,200) 

REAL*4 

description of plot element 

c 

XRANGE 

REAL *4 

range of x values 

c 

XY 

CHAR* 16 

Intermediate variable 

c 

XO 

REAL*8 

Intermediate variable 

c 

XI 

REAL*8 

Intermediate variable 

c 

X2 

REAL*8 

Intermediate variable 

c 

X3 

REAL*8 

Intermediate variable 

c 

YRANGE 

REAL*4 

range of y values 

c 

YO 

REAL*8 

Intermediate variable 

c 

Y1 

REAL*8 

Intermediate variable 

c 

Y2 

REAL*8 

Intermediate variable 

c 

c 

Y3 

REAL*8 

Intermediate variable 

c 

c 

SUBROUTINE PLSECT(J, ITYPE, POINT, LEN.DIA, VOL) 

c 

p 

Computes plot coordinates for parallel resonator 

L* 

c 

Commons ARCCON 

PIPPXY 


c 


Variables 

In Argument List 

c 

DIA 

REAL*4 

diameter of parallel segment (ft) 

c 

ITYPE(200) 

INTEGER*2 

type plot element 

c 

J 

INTEGER*2 

pointer to element 

c 

LEN 

REAL*4 

length of parallel segment (ft) 

c 

POINT (8, 200) 

REAL*4 

description of plot element 

c 

VOL 

REAL*4 

volume of bypassed segment (ft" 3) 

c 


Local Variables 

c 

ANGOLD 

REAL*4 

Intermediate variable 

c 

ANGSAV 

REAL*4 

Intermediate variable 

c 

COSOLD 

REAL*4 

Intermediate variable 

c 

DIAM 

REAL*4 

Intermediate variable 

c 

PDIA 

REAL*4 

Intermediate variable 

c 

PLEN 

REAL*4 

Intermediate variable 

c 

RADIUS 

REAL*4 

Intermediate variable 

c 

SIDE 

REAL*4 

Intermediate variable 

c 

SINOLD 

REAL*4 

Intermediate variable 

c 

TURN 

REAL*4 

Intermediate variable 
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c 

XHC 


REALM 

Intermediate variable 

c 

XHOLD 


REALM 

intermediate variable 

c 

XHSAV 


REALM 

Intermediate variable 

c 

XLC 


REALM 

Intermediate variable 

c 

XLOLD 


REALM 

intermediate variable 

c 

XLSAV 


REALM 

intermediate variable 

c 

XOLD 


REALM 

Intermediate variable 

c 

XSAV 


REALM 

intermediate variable 

c 

YHC 


REALM 

Intermediate variable 

c 

YHOLD 


REALM 

Intermediate variable 

c 

YHSAV 


REALM 

Intermediate variable 

c 

YLC 


REALM 

intermediate variable 

c 

YLOLD 


REALM 

Intermediate variable 

c 

YLSAV 


REALM 

intermediate variable 

c 

YOLD 


REALM 

Intermediate variable 

c 

c 

YSAV 


REALM 

intermediate variable 

c 

c 

SUBROUTINE PNYQ(KR , KC , KW , PTS , ITYPE ) 

c 

c 

Plots 

gain 

and phase angle 

c 



Variables In Argument List 

c 

ITYPE 


INTEGER*2 

which K() 

c 

KC(PTS) 


REALM 

complex part of K() 

c 

KR(PTS) 


REALM 

real part of () 

c 

KW(PTS) 


REALM 

frequency 

c 

PTS 


INTEGERS 

number of points 

c 



Local Variables 

c 

DUMWIL 


INTEGERS 

Intermediate variable 

c 

I 


INTEGERS 

do loop Index 

c 

X(1001) 


REALM 

log of frequency (base 10) 

c 

XHI 


REALM 

Intermediate variable 

c 

XLO 


REALM 

Intermediate variable 

c 

XMAX 


REALM 

maximum x value 

c 

XMIN 


REALM 

minimum x value 

c 

XP 


REALM 

x point to plot 

c 

XY 


CHAR* 16 

Intermediate variable 

c 

YC(1001) 


REALM 

phase angle 

c 

YMAXC 


REALM 

maximum phase angle 

c 

YMAXR 


REALM 

maximum amplitude 

c 

YMINC 


REALM 

minimum phase angle 

c 

YMINR 


REALM 

minimum amplitude 

c 

YP 


REALM 

y point to plot 

c 

c 

YR(lOOl) 


REALM 

ampl Itude 

c 

c 

SUBROUTINE RLINE(TITL , PMRAT 

, SEGMN , SECTN , PIPE1 , PIPE2 , PIPE3 , 

c 

PIPE4,PIPE5,L 

, AREA , DI A , PINO , PCAP , LOPEND , LOPOLD , SPLIT , IUNIT ) 

c 

Reads 

fuel 

or lox file 



c 

C Common WORKIT 

C Variables in Argument List 
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c 

AREA(75) 

REALM 

area of pipe section (ft" 2) 

c 

DIA(75) 

REALM 

diameter of pipe section (ft) 

c 

IUNIT 

INTEGER*2 

unit number of current file (fuel or lox) 

c 

L ( 75 ) 

REALM 

length of pipe section (ft) 

c 

LOPEND 

INTEGER*2 

maximum number of Iterations for split p1| 

c 

LOPOLD 

INTEGERS 

previous value of LOPEND 

c 

PCAP(75) 

REALM 

capacitance of pipe section 

c 

PIND(75) 

REALM 

Inductance of pipe section 

c 

PIPEK75) 

REALM 

first parameter of pipe description 

c 

PIPE2(75) 

REALM 

second parameter of pipe description 

c 

PIPE3(75) 

REALM 

third parameter of pipe description 

c 

PIPE4(75) 

REALM 

fourth parameter of pipe description 

c 

PIPE5(75) 

REALM 

fifth parameter of pipe description 

c 

PMRAT 

REALM 

chamber pressure/total mass flow 

c 

SECTN(75) 

INTEGERS 

pipe section types 

c 

SEGMN 

INTEGERS 

number of pipe sections 

c 

SPLIT 

REALM 

number of lines from pipe split 

c 

TITL 

CHAR*20 

title from fuel or lox file 

c 


Local Variables 

c 

ANS 

REALM 

response to question 

c 

AREAB 

REALM 

Intermediate variable 

c 

AVGK 

REALM 

average bulk modulus 

c 

DIME 

REALM 

Intermediate variable 

c 

GRAV 

REALM 

gravitational constant (lbm-ft/lbf-sec"2) 

c 

I 

INTEGERS 

do loop Index 

c 

PI 

REALM 

mathematical constant 

c 

c 

VALUE 

REALM 

Intermediate variable 

c 

c 

SUBROUTINE 

SETPLT 



C Sets up the plot environment 

C 

C Commons BLANK NOCOL WCAPAS 

C 

C 

C SUBROUTINE STSECT ( J , ITYPE , POINT, LEN ,DIA) 

C Computes plot coordinates for a straight section 

c 

C Common PIPPXY 
C 

C DIA 

C ITYPE (200) 

C J 
C LEN 

C POINT(8, 200) 

C 
C 

C SUBROUTINE TSSECT(J, ITYPE, POINT, LEN, DIA) 

C Computes plot coordinates for a tuned stub 

C 

C Common PIPPXY 

C Variables In Argument List 


Variables In Argument List 
REALM diameter of segment (ft) 
INTEGER*2 type plot element 
INTEGER*2 pointer to element 
REALM length of segment (ft) 
REALM description of plot element 
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c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


DIA REALM diameter of tuned stub (ft) 

ITYPE(200) INTEGER*2 type plot element 

J INTEGER*2 pointer to element 

LEN REALM length of tuned stub 

POINT(8,200) REALM description of plot element 

Local Variables 

DIAM REALM intermediate variable 


SUBROUT I N E UPPERW ( X00 , Y00 , X 1 1 , Y 1 1 , 1 LOX , R ) 
Sets up upper plotting window 


Commons BLANK 

I LOX 
R 

xoo 

Xll 

Y00 

Yll 

ADDX 

ADDY 

COLS 

DUMMY 

HALFY 

PICX 

PICY 

ROWS 

S 

XRANG 

XRAT 

XWIDTH 

XO 

XI 

YHEIGHT 

YRANG 

YRAT 

YO 

Y1 


NOCOL WCATIT 
Variables In Argument List 
INTEGER*2 flag Indicating presence of lox line 
CHAR*1 flag Indicating fuel or lox 
REALM minimum x value 

REALM maximum x value 

REALM minimum y value 

REALM maximum y value 

Local Variables 

REALM Intermediate variable 

REALM Intermediate variable 

INTEGERM number of text columns 
INTEGER*2 Intermediate variable 

REALM Intermediate variable 

REALM Intermediate variable 

REALM Intermediate variable 

INTEGERS number of text rows 
CHARM Intermediate variable 

REALM Intermediate variable 

REALM Intermediate variable 

INTEGERS number ox x pixels 

REALM minimum x value 

REALM maximum x value 

INTEGERS number of y pixels 

REALM intermediate variable 

REALM Intermediate variable 

REALM minimum y value 

REALM maximum y value 


SUBROUTINE WINDLO(XMIN , XMAX , YMIN , YMAX) 

Sets up gain window 

Commons BLANK NOCOL 

Variables In Argument List 
XMAX REAL *8 maximum x value 

XMIN REALM minimum x value 

YMAX REALM maximum y value 

YMIN REALM minimum y value 

Local Variables 
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c 

COLS 


INTEGER*2 

number of text columns 

c 

DUMMY 


INTEGERS 

intermediate variable 

c 

HALFY 


INTEGER*2 

intermediate variable 

c 

ROWS 


INTEGERS 

number of text rows 

c 

XLEN 


REAL*8 

Intermediate variable 

c 

XMAXP 


REAL*8 

maximum x value 

c 

XMINP 


REAL*8 

minimum x value 

c 

XWIDTH 


INTEGERS 

number of x pixels 

c 

YHEIGHT 


INTEGERS 

number of y pixels 

c 

YLEN 


REAL*8 

Intermediate variable 

c 

YMAXP 


REAL*8 

maximum y value 

c 

c 

YMINP 


REAL*8 

minimum y value 

c 

c 

SUBROUTINE WINDUP(XMIN , XMAX , YMIN , YMAX) 

c 

p 

Sets 

up phase angle window 

c 

Commons 

BLANK 

NOCOL 


c 



Variables 

In Argument List 

c 

XMAX 


REAL*8 

maximum x value 

c 

XMIN 


REAL*8 

minimum x value 

c 

YMAX 


REAL*8 

maximum y value 

c 

YMIN 


REAL*8 

minimum y value 

c 



Local Variables 

c 

COLS 


INTEGERS 

number of text columns 

c 

DUMMY 


INTEGER*2 

Intermediate variable 

c 

HALFY 


INTEGER*2 

Intermediate variable 

c 

ROWS 


INTEGER*2 

number of text rows 

c 

XLEN 


REAL*8 

Intermediate variable 

c 

XMAXP 


REAL*8 

maximum x value 

c 

XMINP 


REAL*8 

minimum x value 

c 

XWIDTH 


INTEGER*2 

number of x pixels 

c 

YHEIGHT 


I NT EGER* 2 

number of y pixels 

c 

YLEN 


REAL*8 

Intermediate variable 

c 

YMAXP 


REAL*8 

maximum y value 

c 

c 

YMINP 


REAL*8 

minimum y value 

c 

c 

SUBROUTINE WORKFR ( A , CHAN , CTANK, DENS , KMAN , KTANK , LFLOW , TFLOW , VOL , 

c 



VOLMF.PCHMB, DPROR) 

c 

n 

Moves arguments from common /WORKIT/ 

c 

Common 

WORKIT 



c 



Variables 

In Argument List 

c 

A 


REAL*4 

speed of sound In the fluid (ft/sec) 

c 

CMAN 


REAL*4 

manifold capacitance 

c 

CTANK 


REAL*4 

tank capacitance 

c 

DENS 


REAL*4 

density of fluid (lbm/ft~3) 

c 

DPROR 


REAL*4 

pressure drop across orflces (lbf/ft~2) 

c 

KMAN 


REAL*4 

bulk modulus of manifold (lbf/ft~2) 

c 

KTANK 


REAL*4 

bulk modulus of tank (1bf/ft~2) 

c 

LFLOW 


REAL*4 

flow rate through pipe (lbm/sec) 
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c 

PCHMB 

REAL*4 

chamber pressure (lbf/ft"2) 

c 

TFLOW 

REAL*4 

total flow rate of engine (lbm/sec) 

c 

VOL 

REAL*4 

volume of tank (ft" 3) 

c 

c 

VOLMF 

REAL*4 

volume of manifold (ft"3) 

c 

c 

SUBROUTINE WORKTO ( A , CMAN , CTANK, DENS , KMAN , KTANK , LFLOW , TFLOW , VOL , 

c 


VOLMF, PCHMB, DPROR) 

c 

c 

Moves arguments to common /WORKIT/ 

V 

c 

Common WORKIT 



c 


Variables 

in Argument List 

c 

A 

REAL*4 

speed of sound In the fluid (ft/sec) 

c 

CMAN 

REAL*4 

manifold capacitance 

c 

CTANK 

REAL*4 

tank capacitance 

c 

DENS 

REAL*4 

density of fluid (lbm/ft"3) 

c 

DPROR 

REAL*4 

pressure drop across orflces (lbf/ft"2) 

c 

KMAN 

REAL*4 

bulk modulus of manifold (lbf/ft"2) 

c 

KTANK 

REAL*4 

bulk modulus of tank (lbf/ft"2) 

c 

LFLOW 

REAL*4 

flow rate through pipe (lbm/sec) 

c 

PCHMB 

REAL*4 

chamber pressure (lbf/ft"2) 

c 

TFLOW 

REAL*4 

total flow rate of engine (lbm/sec) 

c 

VOL 

REAL*4 

volume of tank (ft"3) 

c 

c 

VOLMF 

REAL*4 

volume of manifold (ft"3) 

c 

c 

SUBROUTINE ZREAD(NAME, VALUE) 

c 

r 

Reads Input 

for input modification 

V 

C 


Variables 

In Argument List 

c 

NAME(8) 

CHAR*1 

name of Input variable 

c 

VALUE 

REAL*4 

value of input variable 

c 


Local Variables 

c 

BLK 

CHAR*1 

r I 

c 

CARD(80) 

CHAR*1 

card Image 

c 

CEND(3) 

CHAR*1 

’E’.’NVD’ 

c 

COMMA 

CHAR*1 

I 9 

9 

c 

CTIT(5) 

CHAR*1 

’TVIVTVLVE’ 

c 

DCARD 

CHAR*80 

card Image 

c 

E 

CHAR* 1 

’E’ 

c 

FRACT 

REAL*4 

fractional part of number 

c 

I 

INTEGER*2 

do loop Index 

c 

ICOUNT 

INTEGER*2 

position counter 

c 

ID 

INTEGER*2 

position counter 

c 

II 

INTEGER*2 

position counter 

c 

J 

INTEGER*2 

do loop index 

c 

JJ 

INTEGER*2 

position counter 

c 

LE 

CHAR*1 

’e’ 

c 

LEND(3) 

CHAR*1 

’eVnVd’ 

c 

LTIT(5) 

CHAR*1 

’tVI VtVlVe’ 

c 

MINUS 

CHAR*1 

9 _ J 

c 

NUMBER (10) 

CHAR*1 

’0\’l V2V3V4V5V6V7 \’8 \’9’ 
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C 

PERIOD 

CHAR*1 

1 > 

C 

PLUS 

CHAR*1 


C 

POUND 

CHAR*1 


c 

QUEST 

CHAR*1 


c 

SIGN 

REAL*4 

sign of number or exponent 

c 

WHOLE 

REAL*4 

WHOLE PART OF NUMBER 


$ LARGE 

INCLUDE ’ FGRAPH.FI ’ 

INCLUDE ’ FGRAPH . FD ’ 

COMMON /NOCOL/NCOLS , NMODE 
INTEGER*2 NCOLS, NMODE 

INTEGER*2 IHR, IMIN, ISEC, 1100, IYR, IMON, IDAY 
CHARACTER* 2 AM,PM,AP 
COMPLEX GF,GOX,S 

REAL KlR(lOOl), K2R(1001),K3R(1001),K1C(1001),K2C( 1001 ),K3C( 1001) 
REAL K4R( 1001 ) , K4C( 1001 ) , KW( 1001 ) 

REAL PIPEA1(75) ,PIPEA2(75) ,PIPEA3(75) ,PIPEA4(75) 

REAL PIPEB1(75) ,PIPEB2(75) ,PIPEB3(75) ,PIPEB4(75) 

REAL LFREQ , TAUT , CSTAR , RBAR , THETAC , DCDR 

INTEGER SECTNA ( 75 ) , SECTNB( 75 ) , SEGMNA , SEGMNB , PTS , CHOICE 

CHARACTER ANS*1 

CHARACTER*24 NAMLIN(2) 

CHARACTER*40 TITLE 
CHARACTER* 20 TITLF 
CHARACTER*24 VARI 

COMMON /WCATIT/TITLE , TITLF , IHR , IMIN , AP, IYR , IMON , IDAY 
COMMON /WCAOUT/NAMLIN , IUNIT 
COMMON /FACTOR/SFAC 
DATA AM/’AM’/.PM/’PM’/ 

DATA I FUEL/0/, ILOX/O/ 

1 FORMAT (El 5. 6) 

2 FORMAT (I5.4E15.6) 

3 FORMAT ( 1P4E15. 6) 

4 FORMAT (1PE13.5,E12.5,E12.5) 

5 FORMAT (/’ FREQ’ ,8X, ’ FREQ-NORM’ ,9X, ’REALS’ , 11X, ’ IMAGINARY’/) 

8 FORMAT ( 15 , 1P3E15 .6) 

9 FORMAT (Ell. 4, Ell. 4) 

10 FORMAT(A20,1X,I2.2, , :’,I2.2,A2,4X,I2.2, , - , ,I2.2, , -’,I2.2) 

CALL GETTIMUHR, IMIN, ISEC, 1100) 

CALL GETDAT(IYR, IMON, IDAY) 

IYR=IYR-1900 
CALL CLEARSCREEN(O) 

WRITE(*, ’ (10X,A) ’ ) 

W^ITE( *, ’ (10X,A) * ) 1 

*T r 

Ir(IHR. LT. 12) THEN 
WRITE(*, ’ (10X,A) ’ ) 

*’| Good Morning and Welcome to NYQ! ! |* 

AP=AM 
ELSE 
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WRITEC* , ’ ( 10X, A) ’ ) 

*’| Good Afternoon and Welcome to NYQM j 

AP=PM 

IF(IHR.GT. 12) IHR=IHR-12 
ENDIF 

WRITEC*, ’ (10X,A) ’ ) 

*1 I 

WRITEC*, ’ (10X,A) ’ ) 

*’l Program NYQ provides stability predictions I 

WRITEC*, ’ (10X,A ) ’ ) 

*’| of feed line systems ! 

WkITEC*, ’ (10X,A) ’ ) 

*1 I 

WkITEC*, (10X,A) ’ ) 

*’| To send a plot to the printer | 

WRITEC*, ’ (10X,A) ’ ) 

*’l 

WRITE(*, (10X,A)’ ) 

*’| The computer MUST be in GRAPHICS mode 

WRITE(*, ’ (10X,A) ’ ) 

*1 

WRITEC*, (10X,A) ’ ) 

*’| Hit PrScn to send the current plot to the printer 
WRITEC*, ’(10X, A)’) 

wHlTE(*, ’ (10X,A) ’ ) 

*’■ 

WRITE(*,*)’ ’ 

SFAC=1.0 

WRITEC*,*)’ If you want frequency In rad/sec, hit enter.’ 
WRITEC*, ’ (A\) ’) ’ If you want it in Hertz, enter "H". ’ 

READC*, ’ (A) ’ )ANS 

IFCANS.EQ. ’H’ .OR. ANS. EQ. ’h’) SFAC=6. 283185 
20 CONTINUE 

OPEN ( UNIT= 13 , FI LE= ’ CONST . DAT ’ ) 

WRITEC*, ’ CA\) ’) ’ Do you have FUEL data? ’ 

READC*, ’(A)’)ANS 

IFCANS .EQ.’N’ .OR. ANS .EQ. ’n’) THEN 
IFUEL=1 
ELSE 
IGONE=2 

CALL FUEL ( S , GF , PI PEA1 , PIPEA2 , PIPEA3 , PIPEA4 , SEGMNA , SECTNA , IGONE ) 
ENDIF 

WRITEC*, ’ (A\) ’ )’ Do you have LOX data? ’ 

READC*, ’CA)’)ANS 

IFCANS .EQ.’N’ .OR. ANS .EQ. ’n’) THEN 
ILOX=l 
ELSE 
IGONE=2 

CALL LOXCS , GOX , PIPEB1 , PIPEB2 , PIPEB3 , PIPEB4 , SEGMNB , SECTNB , IGONE) 
ENDIF 
IGONE=0 
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C THIS SECTION COMPUTES THE NEW ADMITTANCE OVER VARYING FREQUENCIES. 

95 CONTINUE 

WRITE(*,*)’ Enter 20 character title’ 

READ(*, ’ (A) ’ )TITLF 

WRITECTITLE, 10)TITLF, IHR, IMIN.AP, IMON, IDAY, IYR 
WRITE(*,*)’ Are the following variables in a file? (Y/N) ’ 
WRITE(*,*)’ ’ 

WRITE(*,*) ’ VARIABLES 

WRITE (*,*)’ TRANSPORT LAG’ 

WRITE(*,*) ’ CHARACTERISTIC ROCKET VELOCITY’ 

WRITE(*,*)’ MIXTURE RATIO ’ 

WRITE(*,*)’ CHARACTERISTIC TIME CONSTANT ’ 

WRITE(*,*) ’ CHANGE IN VELOCITY WITH MIXTURE RATIO ’ 

WRITE(* , *) ’ ’ 

READ(*, ’(A)’)ANS 

IF(ANS .EQ. ’N’ .OR. ANS .EQ. ’n’) THEN 

101 CONTINUE 

WRITE(*,*) ’Enter values for VARIABLES as listed above.’ 

READ(* , * , ERR= 100 ) TAUT , CSTAR , RBAR , THETAC , DCDR 
GOTO 102 
100 CONTINUE 

WRITE(*,*)’ Enter numeric values only. Please try again !!’ 

GOTO 101 

102 CONTINUE 

WRITE(13,*)TAUT 
WRITE ( 13, *) CSTAR 
WRITE(13,*)RBAR 
WRITE ( 13, *)THETAC 
WRITE(13,*)DCDR 

WRITEU3,*)’ VARIABLES ’ 

WRITE(13,*)’ TAUT = \TAUT 

WRITE (13,*)’ CSTAR = ’.CSTAR 

WRITEC13,*)’ RBAR = ’ , RBAR 

WRITE( 13,*) ’THETAC = ’.THETAC 

WRITE(13,*)’ DCDR = ’ , DCDR 

ELSE 

WRITE(* , *) ’ Is the name of the file CONST.DAT? (Y/N) ’ 

READ(*, ’ (A) ’ )ANS 

IF(ANS.EQ. ’ N ’ . OR . ANS . EQ . ’n’) THEN 

WRITE(*, ’ (A\) ’ ) ’ Enter name of file with VARIABLES data ’ 

READ(*, ’ (A) ’ )VARI 
OPEN(UNIT=13, FILE=VARI ) 

ENDIF 
REWIND 13 
READ(13,*)TAUT 
READ(13,*)CSTAR 
READ(13,*)RBAR 
READ(13,*)THETAC 
READ(13,*)DCDR 
ENDIF 

27 CONTINUE 
201 CONTINUE 
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IF(SFAC.EQ.l.O) THEN 

WRITE(*,*) ’ Enter range of frequencies in rad/sec ’ 

ELSE 

WRITE(*,*)’ Enter range of frequencies in Hertz ’ 

ENDIF 

WRITE(*,*)’ Low freq=l high freq=2 #pts=10’ 

WRITE(*,*)’ 1001 = Maximum number of points’ 

READ (*,*,ERR= 200 )L FREQ, HFREQ,PTS 
IF(LFREQ.LE.O.O) LFREQ=1.0E-5 
IF(PTS.LE.l) GO TO 30 
GO TO 202 
200 CONTINUE 

WRITE(*,*)’ Enter numeric values only. Please try again !!’ 
GO TO 201 
202 CONTINUE 

C THIS SECTION CALCULATES THE ADMITTANCES FOR FUEL AND LOX, THEN 
C CALCULATES THE COMPLEX K(JW) IN THE "PREDICTION OF THE LINEAR 
C STABILITY BEHAVIOR OF LIQUID PROPELLANT PROPULSION SYSTEMS", 

C VOLUME 1, PAGE 47. 

C 

NPTS=PTS/3 
IF(NPTS.GT.l) THEN 
SSIZE1=0. 1*(HFREQ-LFREQ)/(NPTS-1) 
SSIZE2=0.3*(HFREQ-LFREQ)/NPTS 
IF(3*NPTS. EQ.PTS) THEN 
SSIZE3=0. 6*(HFREQ-LFREQ)/NPTS 
ELSEIF(3*NPTS. EQ. PTS-1) THEN 
SSIZE3=0.6*(HFREQ-LFREQ)/(NPTS+1) 

ELSEIF(3*NPTS. EQ. PTS-2) THEN 
SSIZE3=0.6*(HFREQ-LFREQ)/(NPTS+2) 

ENDIF 

ELSE 

SSIZEl=(HFREQ-LFREQ)/( PTS-1) 

NPTS=PTS 

ENDIF 

C PLOT FUEL PIPE LAYOUT ON SCREEN 1 

CALL SETPLT 

IF(IFUEL.EQ.O) CALL PIPPL0T(SEGMNA,SECTNA,PIPEA1,PIPEA2, 

* PIPEA3,PIPEA4, ILOX, ’A’ ) 
IF(ILOX.EQ.O) CALL PIPPL0T(SEGMNB,SECTNB,PIPEB1,PIPEB2, 

* PIPEB3,PIPEB4,ILOX, ’B’ ) 

CALL clearscreen(O) 

WRITE(*,*)’ Please wait while computations proceed. ’ 
W=LFREQ 
DO 29 K=1,PTS 
IF(K. LE.NPTS) THEN 
IF(K.GT.l) W=W+SSIZE1 
ELSEIF(K.GT.2*NPTS) THEN 
W=W+SSIZE3 
ELSE 

W=W+SSIZE2 

ENDIF 
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IF(K.EQ.PTS) THEN 
W=HFREQ 
ENDIF 
KW(K)=W 

S=CMPLX(0.0,SFAC*W) 

IF(IFUEL.EQ.O) CALL FUEL(S,GF,PIPEA1,PIPEA2,PIPEA3,PIPEA4, 

* SEGMNA , SECTNA , IGONE ) 

IF(ILOX.EQ.O) CALL LOX(S,GOX,PIPEBl,PIPEB2,PIPEB3,PIPEB4, 

* SEGMNB.SECTNB, IGONE) 

CALL NYQUIS ( GF , GOX , S , TAUT , CSTAR , RBAR , DCOR , THETAC , K , KIR , K2R , K3R , 

* K4R , K1C , K2C , K3C , K4C , I FUEL , I LOX ) 

29 CONTINUE 

81 CONTINUE 

WRITEC*,*) ’ Enter graph selection ’ 

WRITEC*,*)’ ’ 

WRITEC*,*) ’ 1 Nyquist plot independent of fuel or lox. ’ 

IF(ILOX.EQ.O) 

* WRITEC*,*)’ 2 Nyquist plot independent of fuel.’ 
IF(IFUEL.EQ.O) 

* WRITEC*,*) ’ 3 Nyquist plot independent of lox.’ 

IF(ILOX.EQ.O. AND. IFUEL. EQ.O) 

* WRITEC*,*)’ 4 Nyquist plot with fuel and lox.’ 

WRITEC*,*)’ 5 Phase-Gain plot Independent of fuel or lox. ’ 
I F ( I LOX .EQ.O) 

* WRITEC*,*)’ 6 Phase-Gain plot Independent of fuel.’ 
IF(IFUEL.EQ.O) 

* WRITEC*,*)’ 7 Phase-Gain plot Independent of lox.’ 

IF(ILOX. EQ.O. AND. IFUEL. EQ.O) 

* WRITEC*,*)’ 8 Phase-Gain plot with fuel and lox.’ 

WRITEC*,*) ’ 9 End plots.’ 

WRITEC*,*)’ ’ 

READ(*,*)CHOICE 
IFCCHOICE.EQ.9) GO TO 30 
I FCCHOICE . LT . 1 . OR. CHOICE . GT . 8 ) THEN 
WRITEC*,*)’ Number must be between 1 and 9, TRY AGAIN’ 

GO TO 81 
ENDIF 

IF(ILOX.EQ.l) THEN 
IF(MOD(CHOICE,2) . EQ.O) THEN 
WRITEC*,*)’ No LOX file, do not use 2, 4, 6, 8’ 

GO TO 81 
ENDIF 
ENDIF 

IFCIFUEL.EQ.1) THEN 

IFC CHOICE. EQ. 3. OR. CHOICE. EQ. 4. OR. CHOICE. GE. 7 ) THEN 
WRITEC*,*)’ No FUEL file, do not use 3, 4, 7, 8’ 

GO TO 81 
ENDIF 
ENDIF 

CALL SETPLT 

CALL GETTIMCIHR, IMIN, ISEC, 1100) 

CALL GETDAT(IYR, IMON, I DAY) 
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IYR=IYR-1900 
IF( IHR. LT. 12) THEN 
AP=AM 
ELSE 
AP=PM 

IF(IHR.GT. 12) IHR=IHR-12 
ENDIF 

IF(CHOICE.EQ.l) CALL ALLPT(K1R, K1C,PTS, 1) 

IF(CHOICE. EQ. 2) CALL ALLPT(K2R,K2C,PTS,2) 

IFCCHOICE.EQ.3) CALL ALLPT(K3R,K3C,PTS,3) 

IFCCHOICE.EQ.4) CALL ALLPT(K4R,K4C,PTS,4) 

IF(CHOICE. EQ. 5) CALL PNYQ(K1R,K1C,KW,PTS,1) 

IF(CHOICE. EQ. 6) CALL PNYQ(K2R,K2C,KW,PTS,2) 

IF(CHOICE. EQ. 7 ) CALL PNYQ(K3R,K3C,KW,PTS,3) 

IF(CHOICE. EQ.8) CALL PNYQ(K4R,K4C,KW,PTS,4) 

CALL ENDPLT 
GO TO 81 
30 CONTINUE 

WRITE(*,*)’ Enter E to exit,’ 

WRITE(*,*) ’ F to run new frequency range,’ 

WRITE(*,*)’ C to run a new case, ’ 

WRITE(*, ’ (A\) ’ ) ’ N to read new files. ’ 

READ(*,’(A)’)ANS 

IF(ANS.EQ. ’F’ .OR.ANS.EQ. ’f’) GO TO 27 
IF(ANS.EQ. ’E’.OR.ANS.EQ. ’e’) STOP 
IF(ANS.EQ. ’C’ .OR.ANS.EQ. ’c’ ) THEN 
IF(IFUEL.EQ.O) THEN 
IGONE=l 

CALL FUEL ( S , GF , PIPEA1 , PIPEA2 , PIPEA3 , PIPEA4 , SEGMNA , SECTNA , IGONE ) 
ENDIF 

IF(ILOX.EQ.O) THEN 
IGONE=l 

CALL LOX(S, GOX , PIPEB1 , PIPEB2 , PIPEB3 , PIPEB4, SEGMNB , SECTNB , IGONE ) 
ENDIF 
IGONE=0 
GO TO 95 
ENDIF 

IF(ANS. EQ. ’N’. OR.ANS.EQ. ’n’) THEN 
IFUEL=0 
ILOX=0 
GO TO 20 
ENDIF 

WRITE(*,*) ’ You did not enter E, F, C, or N. Try again.’ 

GO TO 30 
END 

SUBROUTINE ADMIT ( S , GADM , A , AREA , CMAN , CTANK , DPROR , L , LFLOW , PM RAT , 

♦ SEGMN.SECTN, SPLIT, LOPEND.PCAP, PIND) 

C determines admittance looking toward tank 

CHARACTERS TITLE 
CHARACTERS TITLF 
INTEGER*2 IHR, IMIN, IYR, IMON, IDAY 
CHARACTER*2 AP 
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COMMON /WCAT IT/TITLE , TITLF , IHR , IMIN , AP , IYR , IMON , IDAY 
INTEGER SEGMN,SECTN(75) 

REAL AREA(75) ,PCAP(75) ,PIND(75) , L(75) , LFLOW,ZO(75) 

COMPLEX G(0:75),ZT(0:75),ZG(75) ,GOLD(0: 75) ,GADM,S,G1 , ZGEFF,ZOEFF 
COMPLEX CTANH , RHS , CFAC , CAPN , CAPM 
DATA GRAV/32. 2/ 

ZTOP=A/(GRAV*PMRAT) 

ZOR=2 . 0*DPROR/(LFLOW*PMRAT ) 

GOLD(0)=0. 0 
DO 26 I=1,SEGMN 
GOLD(I)=0. 0 

I F ( SECTN ( I ) . LE . 1 . OR . SECTN ( I ) . EQ . 9 ) THEN 
ZO( I )=ZTOP/AREA( I ) 

ELSEIF(SECTN( I ) . EQ. 2 ) THEN 
ZO( I )=ZTOP/AREA( I ) 

ELSE 

ZO(I)=SQRT(PIND(I)/PCAP(I)) 

ENDIF 

26 CONTINUE 

G(0)=CTANK*PMRAT*S 
G(0)=G(0)/SPLIT 
ZT(0)=1 . 0/G(0) 

DO 281 KLOOP=l,LOPEND 
G1=G(0)+1.0 
DO 27 1=1 ,SEGMN 
ZGEFF=G(I-1) 

IF(SECTN(I) . LE. l.OR.SECTN(I) . EQ.9) THEN 
C BEND IN PIPE OR STRAIGHT SECTION 

TL=L(I)/A 

IF(KLOOP.NE. l.AND.SECTN(I) . EQ.9) THEN 
ZGEFF=G( 1-1 )+(SPLIT-l . 0 )/ZG( 1-1 ) 

ENDIF 

G( I )= ( 1 . 0+CTANH(S*TL )/(ZGEFF*ZO( I ) ) )/( 1 . 0+ZGEFF*Z0( I)* 

* CTANH(S*TL) ) 

ELSEIF(SECTN(I).EQ.2) THEN 

C INLINE RESONATOR ACCUMULATOR 

G( I )=1 . 0+PCAP( I )*S/ZGEFF 
ELSEIF(SECTN(I) . EQ. 3) THEN 
C TUNED STUB ACCUMULATOR 

Gd) = 1.0+CTANH(S*SQRT(PINDd)*PCAPd)))/(ZOd)*ZGEFF) 
ELSEIF(SECTN(I).EQ.4) THEN 
C HELMHOLTZ RESONATOR ACCUMULATOR 

G(I )= 1 . 0+S*PCAPd )/( 1 . 0+PIND( I )*PCAP( I )*S**2 )/ZGEFF 
ELSEIF(SECTN(I) . EQ.5) THEN 
C PARALLEL RESONATOR ACCUMULATOR 

G(I )=PIND(I )*PCAP(I )*S**2+1 . 0 
Gd)=G(I)/(G(I)+PIND(I)*S*ZGEFF) 

ELSEIF(SECTN(I ) . EQ. 6) THEN 
C PUMP 

G (I ) = ( 1 . 0+PCAP (I ) *S/ZGE FF ) / ( 1 . 0+ ( PI ND (I ) *S+AREA (I ) ) * 

* ( PCAP( I ) *S+ZGEFF ) ) 

ENDIF 
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G(I)=G(I)*ZGEFF 

G1=G1*G(I) 

ZT(I)=1.0/G(I) 

27 CONTINUE 

G ( SEGMN+ 1 ) = 1 . 0+CMAN*PMRAT*S/G (SEGMN ) 

G1=G1*G(SEGMN+1) 

G(SEGMN+1)=G(SEGMN+1)*G(SEGMN) 

G ( S EGMN+2 ) = 1 . 0/ ( 1 . 0+ ZOR*G ( SEGMN+ 1 ) ) 

Gl=Gl*G(SEGMN+2) 

G ( S EGMN+ 2 ) = G ( S EGMN+ 2 ) *G ( S EGHN+ 1 ) 

IF(LOPEND.EQ.l) GO TO 281 

ZG ( S EGMN ) = ZOR/ ( ZOR*CMAN*PMRAT *S+ 1.0) 

IF(SEGMN.NE.l) THEN 
DO 271 I=SEGMN-1 ,1,-1 
ZGEFF=ZG(I+1) 

ZOEFF=ZO(I+l) 

IF(SECTN(I+1) . LE. 1.0R.SECTN(I+1) . EQ. 9) THEN 
C BEND IN PIPE OR STRAIGHT SECTION 

TL=(L(I)+L(I+1))/A 
CAPN= ( ZOEFF-ZT ( I— 1 ) )/( ZOEFF+ZT ( I- 1 ) ) 

CAPM= ( ZOEFF-ZGEFF )/ ( ZOEFF+ZGEFF ) 

CFAC=CEXP(-2.0*S*TL) 

RHS= ( ZOEFF+ZGEFF ) * ( 1 . 0-CAPN*CAPM*CFAC ) »CEXP ( S*L ( 1+ 1 ) /A ) 
CFAC=CAPN»CFAC*CEXP(2.0*S*L(I+1)/A) 

ZG( I )=( RHS-ZOEFF* ( 1 . 0-CFAC) )/( 1 . 0+CFAC) 

I F ( SECTN (I+1).EQ.9) THEN 
ZG ( I )=ZG( I)/SPLIT 
ENDIF 

ELSEI F( SECTN ( 1+ 1 ) . EQ. 2) THEN 
C INLINE RESONATOR ACCUMULATOR 

ZG(I)=ZGEFF/(ZGEFF*PCAP(I+1)*S+1.0) 

ELSEIF(SECTN(I+1) . EQ. 3) THEN 
C TUNED STUB ACCUMULATOR 

ZG( I ) =ZOEFF/CTANH( S*SQRT ( PIND( 1+1 ) *PCAP( 1+1 ) ) ) 
ZG(I)=(ZG(I)*ZGEFF)/(ZG(I)+ZGEFF) 

ELSEIF(SECTN(I+1) . EQ. 4) THEN 
C HELMHOLTZ RESONATOR ACCUMULATOR 

ZG(I)=(1 . 0+PIND(I+l)*PCAP(I+l)*S**2)/(PCAP(I+l )*S) 
ZG(I)=(ZG(I)*ZGEFF)/(ZG(I)+ZGEFF) 

ELSEIF(SECTN(I+1) . EQ.5) THEN 
C PARALLEL RESONATOR ACCUMULATOR 

ZG(I)=ZGEFF+PIND(I+1)*S/(PIND(I+1)*PCAP(I+1)*S**2+1.0) 
ELSEIF(SECTN(I+1) . EQ.6) THEN 
C PUMP 

ZG( I )=ZGEFF+PIND( 1+1 )*S-AREA( 1+1 ) 
ZG(I)=ZG(I)/(1.0+ZG(I)»PCAP(I+1)*S) 

ENDIF 
271 CONTINUE 
ENDIF 

IF(KLOOP.EQ.l) GO TO 281 
ERRP=0. 0 

DO 272 1=1, SEGMN 
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GDIF=SQRT((REAL(G(I))-REAL(G0LD(I)))**2+(AIMAG(G(I))- 

* AIMAG(GOLD(I) ) )**2) 

IF(GOIF.GT.ERRP) ERRP=GDIF 

272 CONTINUE 

IF(ERRP. IT. 0.001) GO TO 282 

281 CONTINUE 

IF(LOPEND.EQ.l) GO TO 282 
IF(IOPEN.EQ.O) THEN 
0PEN(UNIT=14,FILE= ’SURF. ERR’) 

WRITE(14,*) ’ ’ 

WRITE(14,*) ’ ’ 

WRITE (14,*) TITLE 
WRITE(14,*) ’ ’ 

IOPEN=l 

ENOIF 

WRITE(14, ’ ( ” jw =”,F8.1,” after’ ’ ,13, ” Iterations”, 

* ” has error of”,F8.3,”% ”)’) 

* AIMAG(S) , LOPEND, 100. 0*ERRP 

282 CONTINUE 

GADM=G(SEGMN+2) 

RETURN 

END 

SUBROUTINE ALLPT ( WHOLD , GHOLD , PTS , ITYPE ) 

C Supervises Nyqulst plot 

INCLUDE ’ FGRAPH . FD ’ 

RECORD/WXYCOORD/XY 

INTEGER*2 DUMWIL 

REAL WHOLD( 1001 ),GHOLD( 1001) 

REAL*8 RMIN,RMAX, IMMIN, IMAX 
REAL*8 X,Y 
INTEGER PTS 
RMAX=WHOLD(l) 

RMIN=WHOLD(l) 

IMAX=GHOLD( 1 ) 

IHMIN=GHOLD(l) 

DO 21 1=2, PTS 

IF(WHOLD(I) .GT.RMAX) RMAX=WHOLD(I) 

IF(WHOLD(I) . LT.RMIN) RMIN=WHOLD(I) 

IF(GHOLD(I) .GT. IMAX) IMAX=GHOLD(I) 

IF(GHOLD(I).LT. IMMIN) IMMIN=GHOLD(I) 

21 CONTINUE 

CALL LOWERW(RMIN,RMAX, IMAX, IMMIN) 

CALL NICEGRF(RMIN , RMAX , IMAX , IMMIN , ITYPE) 

CALL SETLINESTYLE( 62268) 

X=0.0 
Y= IMMIN 

CALL MOVET 0_W ( X , Y , XY ) 

Y=IMAX 

DUMWIL=LINETO_W(X, Y) 

Y=0. 0 
X=RMIN 

CALL MOVETO_W(X,Y,XY) 
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X=RMAX 

DUMWIL=LINETO_W(X,Y) 

CALL SETLINESTYLE( 65535) 

X=WHOLD( 1 ) 

Y=GH0LD(1) 

CALL MOVETO_W ( X , Y , XY ) 

DO 25 1=2, PTS 
X=WHOLD(I) 

Y=GHOLD(I) 

DUMWIL=LINETO_W(X,Y) 

25 CONTINUE 
RETURN 
END 

SUBROUTINE BENDS(PIPE1 , PIPE2 , PIPE3 , PIPE4, VALUE , DIME ) 

C Computes effective straight pipe for bend 

REAL LBEND, INRAD, INERT , LPRME , NEWLN 
BENDR=0 . 0174533*ABS( PIPE2 ) 

LBEND=PIPE1*8ENDR 
ARBND=0. 785398*PIPE3**2 
INRAD=PIPE1-0.5*PIPE3 
0TRAD=PIPE1+0.5*PIPE3 
RAT IO=I NRAD/OTRAD 
X=RATIO 

CALL GINERT (ABS(PIPE2) ,X, Y) 

INERT=(Y*(OTRAD-INRAD) )/ARBND 
LPRME=LBEND/ARBND 
NEWLN=LPRME+INERT 
GAMMA=NEWLN/LPRME 
VALUE=GAMMA* ( LBENIH2 . 0*PIPE4) 

AREAB=ARBND/SQRT (GAMMA) 

DIME=2 . 0*SQRT (AREAB/3 . 1415927 ) 

RETURN 

END 

SUBROUTINE BNSECT ( J , ITYPE , POINT , PIPE1 , PIPE2 , PIPE3 , PIPE4) 

C Computes plot coordinates for a bend 

COMMON /PIPPXY/X , XH , XL , Y , YH , YL , XMIN , XMAX , YMIN , YMAX , SINA , COSA 
COMMON /ARCCON/XC.YC, RAD, ANG, ANGLE 
REAL POINT (8, 200) 

INTEGERS ITYPE(200) 

C BEND 

C FIRST STRAIGHT SECTION OF BEND 

IFCPIPE4.NE.0.0) CALL STSECT(J, ITYPE, POINT, PIPE4.PIPE3) 

C CURVED SECTION OF BEND 

IF(PIPE2.GE.0.0) THEN 
XC=X-SINA*PIPE1 
YC=Y+C0SA*PIPE1 
DIA= 0.5 
ELSE 

XC=X+SINA*PIPE1 
YC=Y-C0SA*PIPE1 
DIA=-0. 5 
ENDIF 
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J=J+1 

ITYPEC J)=0 
POINT (1,J)=XC 
POINT(2, J)=YC 
POINT(3,J)=ANG 
ANG=ANG+0.01745329*PIPE2 
ANGLE=ANGLE+0. 5*PIPE2 
RANG=0.01745329*ANGLE 
COSA= COS (RANG) 

SINA=SIN(RANG) 

RAD=PIPE1-DIA*PIPE3 

POINT(4,J)=ANG 

POINT(5, J)=RAD 

X0=XC-RAD 

Y0=YC+RAD 

X1=XC+RAD 

Y1=YC-RAD 

X2=XH 

Y2=YH 

SLENTH=2 . 0*RAD*SIN(0. 00872665*ABS(PIPE2 ) ) 

XH=X2+COSA*SLENTH 

YH=Y2+SINA*SLENTH 

X3=XH 

Y3=YH 

IFCDIA.LT. 0.0) THEN 
HOLD=X2 
X2=X3 
X3=HOLD 
HOLD=Y2 
Y2=Y3 
Y3=HOLD 
ENDIF 

RAD=PIPE1+DIA*PIPE3 

X0=XC-RAD 

Y0=YC+RAD 

X1=XC+RAD 

Y1=YC-RAD 

X2=XL 

Y2=YL 

SLENTHs 2 . 0*RAD*SIN(0 . 00872665*ABS( PIPE2 ) ) 

XL=X2+COSA*SLENTH 

YL=Y2+SINA*SLENTH 

X3=XL 

Y3=YL 

IF(DIA.LT. 0.0) THEN 
HOLD=X2 
X2=X3 
X3=HOLD 
HOLD=Y2 
Y2=Y3 
Y3=HOLD 
ENDIF 
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J=J+1 

ITYPE(J)=0 

P0INT(1,J)=P0INT(1, J-l) 
POINT(2,J)=POINT(2,J-l) 

POINT ( 3 , J ) =POINT ( 3 , J- 1 ) 

POINT(4, J)=POINT(4, J-l) 

POINT(5 , J )=RAD 

SLENTH=2.0*PIPE1*SIN(0.00872665*ABS(PIPE2)) 

X=X+COSA*SLENTH 

Y=Y+SINA*SLENTH 

XMIN=AMIN1(X,XL,XH,XMIN) 

XMAX=AMAX1 (X , XL , XH , XMAX) 

YMIN=AMIN1 ( Y , YL , YH , YMIN ) 

YMAX= AMAX 1 ( Y , YL , YH , YMAX ) 

C LAST STRAIGHT SECTION OF BEND 

ANGLE=ANGLE+0.5*PIPE2 
RANG=0 . 0 1745329*ANGLE 
COSA= COS ( RANG ) 

SINA=SIN(RANG) 

J=J+1 

ITYPE(J)=1 

POINT(l f J)=XH 

POINT(2,J)=YH 

POINT(3,J)=XL 

POINT(4,J)=YL 

X=X+C0SA*PIPE4 

XH=X-0.5*SINA»PIPE3 

XL=X+0.5*SINA«PIPE3 

Y=Y+SINA*PIPE4 

YH=Y+0.5*COSA*PIPE3 

YL=Y-0.5*COSA*PIPE3 

POINT(5,J)=XH 

POINT(6,J)=YH 

POINT(7,J)=XL 

POINT(8,J)=YL 

XHIN=AMIN1(X, XL,XH,XMIN) 

XMAX= AMAX1 ( X , XL , XH , XMAX ) 

YMIN=AMIN1(Y, YL ,YH, YMIN) 

YMAX=AMAX1 (Y , YL , YH , YMAX) 

RETURN 

END 

COMPLEX FUNCTION CCOSH(S) 

C Evaluates the complex hyperbolic cosine 

COMPLEX S 
REAL LAMDA, MU 
LAMDA=REAL(S) 

MU=AIMAG(S) 

COSHR= COSH ( LAMDA ) *COS ( MU ) 
COSHI=SINH(LAMDA)*SIN(MU) 

CCOSH= CMPLX ( COSHR , COSHI ) 

RETURN 

END 
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COMPLEX FUNCTION CSINH(S) 

C Evaluates the complex hyperbolic sine 

COMPLEX S 
REAL LAMDA , MU 
LAMDA=REAL(S) 

MU=AIMAG(S) 

SINHR=SINH( LAMDA ) *COS (MU ) 

SINHI=COSH( LAMDA )*SIN (MU) 

CSINH=CMPLX(SINHR , SINHI ) 

RETURN 

END 

COMPLEX FUNCTION CTANH(S) 

C Evaluates the complex hyperbolic tangent 

COMPLEX CCOSH,CSINH,S 
CTANH=CSINH ( S ) /CCOSH ( S ) 

RETURN 

END 

SUBROUTINE CURV(A1,A2) 

C Draws circular arc 

INCLUDE ’FGRAPH.FD’ 

RECORD/WXY COORD/XY 
INTEGER*2 DUMWIL 

COMMON /ARCCON/XC.YC, RAD, ANG, ANGLE 

REAL*8 XP, YP,A1 ,A2 

ANG1=A1 

ANG2=A2 

DTH=ANG2-ANG1 

IF(DTH.LT.O.O) DTH=6. 283185+DTH 

N=57.29578*DTH 

DA=DTH/(N-1) 

XP=XC+RAD*SIN(ANG1) 

YP=YC-RAD*COS(ANGl) 

CALL MOVETO_W(XP,YP,XY) 

DO 21 1=1 , N-l 

T=ANG1+I*DA 

XP=XC+RAD*SIN(T) 

YP=YC-RAD*COS(T) 

DUMWIL=LINETO_W(XP, YP) 

21 CONTINUE 
RETURN 
END 

SUBROUTINE ENDPLT 
C Closes plot routines 

INCLUDE ’FGRAPH.FD’ 

INTEGER*2 dummy 

READ (*,*) ! Walt for ENTER key to be pressed 

dummy = setv1deomode( IDEFAULTMODE ) 

RETURN 

END 

LOGICAL FUNCTION fourcolorsQ 
C Determines type of graphics monitor 

INCLUDE ’FGRAPH.FD’ 
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INTEGER*2 dummy 

RECORD /videoconfig/ screen 
COMMON screen 

Set to maximum number of available colors. 

CALL getvideoconfig( screen ) 

SELECT CASE( screen. adapter ) 

CASE( $CGA, $OCGA ) 

dummy = setvideomode( $MRES4COLOR ) 

CASE( $EGA, $OEGA ) 

dummy = setv1deomode( $ERESCOLOR ) 

CASE( $VGA, $OVGA ) 

dummy = setv1deomode( IVRES16COLOR ) 

CASE DEFAULT 
dummy = 0 
END SELECT 

CALL getvideoconf ig( screen ) 
fourcolors = .TRUE. 

IF( dummy .EQ. 0 ) fourcolors = .FALSE. 

END 

SUBROUTINE FUEL (S , GF , PIPEA1 , PIPEA2 , PIPEA3 , PIPEA4 , SEGMNA , SECTNA , 
* IGONE) 

C Handles fuel piping logic 

COMMON /WORKIT/WORK(12) 

COMPLEX GF,S 

REAL AREA(75),DIA(75),L(75),KMAN,PIND(75),PCAP(75) 

REAL DENS , A , L FLOW , KTANK , CMAN , CTANK , VOL , VOLMF 
REAL PIPEA1(75) ,PIPEA2(75) ,PIPEA3(75) ,PIPEA4(75) , PIPEA5(75) 
INTEGER SEGMNA, SECTNA(75),SECTA 
CHARACTERS FUELIN,NAMLIN(2) 

COMMON /WCAOUT /N AMLIN, I UN IT 
CHARACTER*20 TITLF 
CHARACTER* 1 ANS 
DATA ISTRT/0/ 

1 FORMAT (El 5. 6) 

2 FORMAT ( 15 , 4E15 . 6 ) 

IMORE=0 

IF(IGONE.EQ.2) THEN 

WRITE(*, ’(A\)’)’ Is fuel line data In a file? (Y/N) ’ 

READ(*, ' (A) ’ )ANS 

IFCANS.NE. ’N’ .AND. ANS. NE. ’n’) THEN 
WRITE(*, ’ (A\) ’ ) ’ Is the file name FUEL.INP? (Y/N) ’ 

READ(*, ’ (A) ’ )ANS 

IF(ANS.NE. ’N’ .AND. ANS. NE. ’n’) THEN 
OPEN(UNIT=ll,FILE= ’FUEL.INP’) 

NAMLIN(1)=’ FUEL.INP’ 

ELSE 

WRITE(*, ’ (A\) ’ ) ’ Enter name of file with fuel line data ’ 
READ(*, ’ (A) ’ )FUELIN 
OPEN(ll ,FILE=FUELIN) 

NAMLIN(1)=FUELIN 
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ENDIF 

IM0RE=1 

ENDIF 

IGONE=0 

ENDIF 

65 CONTINUE 

IFUSTRT . EQ.O.AND. IGONE.EQ.O) THEN 
ISTRT=1 

IF(IMORE.EQ.l) GO TO 66 

CALL WORKTO( A , CMAN , CTANK , DENS , KMAN , KTANK , LFLOW , TFLOW , VOL , VOLMF , 

* PCHMB,DPROR) 

CALL MODI FY ( AREA , DIA , L , PIPEA1 , PIPEA2 , PIPEA3 , PIPEA4 , PI PEAS , 

* SECTNA , SEGMNA , SECT A , PIND , PCAP , LOPEND , LOPOLD , SPLIT , PMRAT , ’ A ’ ) 
CALL WORKFR (A , CMAN , CTANK , DENS , KMAN , KTANK, LFLOW , TFLOW , VOL , VOLMF , 

* PCHMB.DPROR) 

IF(IUNIT.EQ.O) THEN 

WRITE(* , *) ’ You do not have any data stored, please re-read’ 
WRITE(*,*)’ the questions and answer carefully.’ 

ISTRT=0 
WRITE(*,*)’ ’ 

GOTO 65 
ENDIF 
REWIND 11 

66 CONTINUE 

CALL WORKTO ( A , CMAN , CTANK , DENS , KMAN , KTANK, LFLOW , TFLOW , VOL , VOLMF , 

* PCHMB.DPROR) 

CALL RLINEdITLF, PMRAT, SEGMNA, SECTNA, PIPEA1.PIPEA2, 

* PIPEA3 , PI PEA4 , PI PEA5 , L , AREA , DIA , PIND , PCAP , LOPEND , LOPOLD , 

* SPLIT, 11) 

CALL WORKFR ( A , CMAN , CTANK , DENS , KMAN , KTANK , LFLOW , T FLOW , VOL , VOLMF , 

* PCHMB,DPROR) 

WRITEO,*)’ For changes In fuel line data enter Y,’ 

WRITE(*, ’ (A\) ’ ) ’ if not, press enter key.’ 

READ(*, ’ (A) ’ )ANS 
WRITE(*,*) ’ ’ 

IF(ANS .EQ. ’Y’ .OR. ANS .EQ. ’y’) THEN 

CALL WORKTO( A , CMAN , CTANK , DENS , KMAN , KTANK, LFLOW , TFLOW , VOL , VOLMF , 

* PCHMB.DPROR) 

CALL MODIFYC AREA , DIA , L , PIPEA1 , PIPEA2 , PIPEA3 , PIPEA4 , PIPEA5 , 

* SECTNA, SEGMNA, SECTA, PIND, PCAP, LOPEND, LOPOLD, SPLIT, PMRAT, ’A’) 
CALL WORKFR ( A , CMAN , CTAN K , DENS , KMAN , KTANK , LFLOW , T FLOW , VOL .VOLMF, 

* PCHMB.DPROR) 

ENDIF 

RETURN 

ELSEIF(ISTRT .EQ. 1 .AND. IGONE .EQ.O) THEN 
CALL ADMIT ( S , GF , A , AREA , CMAN , CTANK , DPROR , L , LFLOW , PMRAT , SEGMNA , 

* SECTNA, SPLIT, LOPEND, PCAP, PIND) 

RETURN 

ELSEIF(ISTRT .EQ. 1 .AND. IGONE .EQ. 1) THEN 

WRITE(*, ’ (A\) ’ ) ’ Do you wish to modify current fuel line data? ’ 
READ(*, ’ (A) ’ )ANS 

IF(ANS .EQ. ’Y’ .OR. ANS .EQ. ’y’) THEN 
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CALL WORKTO ( A , CMAN , CTANK , DENS , KMAN , KTANK , LFLOW , TFLOW , VOL , VOLMF , 

* PCHMB , DPROR ) 

CALL MODIFY ( AREA , DIA , L , PIPEA1 , PIPEA2 f PIPEA3 , PIPEA4 , PI PEA5 , 

* SECTNA , SEGMNA , SECTA , PIND , PCAP , LOPEND, LOPOLD, SPLIT , PMRAT , ’ A ’ ) 
CALL WORKFR ( A , CMAN , CTANK , DENS , KMAN ? KTANK , LFLOW , TFLOW , VOL , VOLMF , 

* PCHMB, DPROR) 

ELSE 

WRITEC*, ’ (A\) ’ ) ’ Do you wish to rewind fuel line file? ’ 

READ(*, ’ (A) ’ )ANS 

IF(ANS .EQ. ’Y’ .OR. ANS .EQ. ’y’) REWIND 11 

CALL WORKTO( A , CMAN , CTANK , DENS , KMAN , KTANK, LFLOW , TFLOW , VOL , VOLMF , 

* PCHMB, DPROR) 

CALL RLINE(TITLF, PMRAT , SEGMNA , SECTNA, PIPEA1 , PIPEA2 , 

* PIPEA3 , PIPEA4 , PIPEA5 , L , AREA , DIA , PIND , PCAP , LOPEND , LOPOLD , 

* SPLIT, 11) 

CALL WORKFR (A , CMAN , CTANK , DENS , KMAN , KTANK , LFLOW , TFLOW , VOL , VOLMF , 

* PCHMB, DPROR) 

WRITEC*,*)’ For changes In fuel line data enter Y,’ 

WRITEC*, ’ (A\) ’ ) ’ If not, press enter key.’ 

READC*,’(A)’)ANS 
WRITEC*,*)’ ’ 

IF(ANS .EQ. *Y* .OR. ANS .EQ. ’y’) THEN 

CALL WORKTO ( A , CMAN , CTAN K , DENS , KMAN , KTANK , LFLOW , T FLOW , VOL , VOLMF , 

* PCHMB, DPROR) 

CALL MODI FY ( AREA , DIA , L , PIPEA1 , PIPEA2 , PIPEA3 , PIPEA4 , PIPEA5 , 

* SECTNA, SEGMNA, SECTA, PIND, PCAP, LOPEND, LOPOLD, SPLIT, PMRAT, ’A’) 
CALL WORKFR (A , CMAN , CTANK , DENS , KMAN , KTANK , LFLOW , TFLOW , VOL , VOLMF , 

* PCHMB, DPROR) 

ENDIF 

ENDIF 

IGONE=0 

ENDIF 

RETURN 

END 

SUBROUTINE GINERT(BEND,X, Y) 

C Evaluates curve fit of Inertance of bends 

DIMENSION B ( 3 ) 

DATA B/0.0,0. 7877014E-02 , -0 . 2814679E-04/ 

A=B(1)+(B(2)+B(3)*BEND)*BEND 

Y=A*(X-1.0)**2 

RETURN 

END 

SUBROUTINE HHSECT(J, ITYPE, POINT, LEN.OIA, VOL) 

C Computes plot coordinates for Helmholtz resonator 

COMMON /PI PPXY/X , XH , XL , Y , YH , YL , XMIN , XMAX , YMIN , YMAX , S I NA , COSA 
REAL LEN, POINT (8, 200) 

INTEGER*2 ITYPE(200) 

X0LD=X 

XHOLD=XH 

XLOLD=XL 

Y0LD=Y 

YHOLD=YH 
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YLOLD=YL 

SINOLD=SINA 

COSOLD=COSA 

DIAM=SQRT ( (XH-XL ) **2+ ( YH- YL ) **2 ) 

CALL TSSECT(J , ITYPE , POINT , LEN , DIA) 

XC=0. 5*(XOLD+X) 

YC=0.5*(YOLD+Y) 

XOLD=X 
YOLD=Y 
S I NA= COSOLD 
COSA=-SINOLD 

X=XC+COSA*(LEN+0. 5*DIAM) 

Y= YC+SINA* (LEN+0 . 5*DIAM ) 

SIDE=VOL**0. 3333333 

CALL STSECT ( J , ITYPE , POINT , SIDE , SIDE) 

X=XOLD 
Y=YOLD 
SINA=SINOLD 
COSA= COSOLD 

DIAM=SQRT ( ( XHOLD-XLOLD ) **2+ ( YHOLD-YLOLD)**2 ) 

XH=X-0.5*SINA*DIAM 

XL=X+0.5*SINA*DIAM 

YH=Y+0.5*C0SA*DIAM 

YL=Y-0.5*COSA*DIAM 

RETURN 

END 

SUBROUTINE LABANG ( XMIN , XMAX , YMIN, YMAX ) 

C Labels phase angle plot 

INCLUDE ’FGRAPH.FD’ 

RECORD/WXYCOORD/XY 

RECORD /vldeoconf 1g/ screen 

COMMON screen 

CHARACTERMO TITLE 

CHARACTERS TITLF 

INTEGER*2 IHR,IMIN,IYR,IMON,IDAY 

CHARACTER* 2 AP 

COMMON /WCATIT/TITLE , TITLF , I HR , IMIN , AP, IYR , IMON , IDAY 

COMMON /NOCOL/NCOLS , NMODE 

COMMON /FACTOR/SFAC 

INTEGER*2 NCOLS 

INTEGER*2 row, rows 

INTEGER*2 DUMWIL 

RECORD/RCCOORD/S 

REAL*8 XMIN, XMAX, YMIN, YMAX, XP, YP 
CHARACTER*6 YLO, YHI 
CHARACTER*? XHI 
DATA YLO/’ -180*’/ 

DATA YHI/’ 180*7 

1 FORMAT (F6. 3) 

2 FORMAT (F7. 2) 

rows = screen. numtext rows 
IF(NMODE.EQ.6) THEN 
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CALL settextpos1t1on( 1, l, s) 

ELSE 

CALL settextpos1t1on( 0, 20, s) 

ENDIF 

CALL OUTTEXT(TITLE) 

dummy = rectangle_w( IGBORDER, XMIN, YMIN, XHAX, YMAX ) 
row= rows/4 

CALL SETTEXTPOSITION(row, l,s) 

IF(NCOLS. LE. 40) THEN 
CALL OUTTEXT( ’Angle’) 

ELSE 

CALL OUTTEXT ( ’ Phase Angle’) 

ENDIF 

IFCNMODE.EQ.6) THEN 
CALL SETTEXTPOSITION( rows/2-1 , 18, s) 

CALL OUTTEXT(’freq’) 

ELSE 

CALL SETT EXTPOSITION( rows/2-1 , 35,s) 

IF(SFAC.EQ.l.O) THEN 
CALL OUTT EXT ( ’Frequency - rad/sec’) 

ELSE 

CALL OUTTEXT (’Frequency - Hertz ’) 

ENDIF 

ENDIF 

CALL GETTEXTPOSITION(s) 

IF(NM0DE.EQ.6) THEN 
CALL SETTEXTP0SITI0N(3, l,s) 

CALL OUTTEXT (YHI) 

CALL SETTEXTPOSITIONCs. row-3,1 ,s) 

CALL OUTTEXT (YLO) 

CALL GETTEXTPOSITION ( s ) 

ILOC=4 

IMAX=26 

ELSEIF(NMODE. EQ. 16) THEN 
CALL SETTEXTPOSITION(2, 10,s) 

CALL OUTTEXT (YHI) 

CALL SETTEXTPOSITION(s. row-2, 10, s) 

CALL OUTTEXT (YLO) 

CALL GETTEXTPOSITION ( s ) 

ILOC=13 

IMAX=54 

ELSE 

CALL SETTEXTPOSITION(2, 10,s) 

CALL OUTTEXT (YHI) 

CALL SETTEXTPOSITION(s. row-2, 10, s) 

CALL OUTTEXT (YLO) 

CALL GETTEXTPOSITION(s) 

ILOC=13 

IMAX=54 

ENDIF 

ILO=XMIN 

IHI=XMAX 
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IDEL=IMAX/( IHI-ILO) 
row=s. row+1 
DO 21 I=ILO, IHI 
HI=10.0**I 
WRITE(XHI,2)HI 

CALL SETTEXTPOSITION( row, ILOC,s) 

CALL OUTTEXT(XHI) 

ILOC=ILOC+IDEL 

IF(I . EQ. ILO.OR. I . EQ. IHI ) GO TO 21 
CALL SETLINESTYLE( 62268) 

XP=I 

YP=YMIN 

CALL MOVETO_W ( XP , YP , XY ) 

YP=YMAX 

DUMWIL=LINETO W(XP,YP) 

CALL SETLINESTYLE( 65535) 

21 CONTINUE 
RETURN 
END 

SUBROUTINE LABGAIN (XMIN , XMAX , YMIN , YMAX , ITYPE ) 

C Labels gain plot 

INCLUDE ’FGRAPH.FD’ 

RECORD/WXYCOORD/XY 

RECORD /vldeoconf 1 g/ screen 

COMMON screen 

CHARACTER*40 TITLE 

CHARACTER*20 TITLF 

INTEGER*2 I HR , IMIN , IYR , IMON , IDAY 

CHARACTER* 2 AP 

COMMON /WCATIT/TITLE , TITLF , I HR , IMIN , AP, IYR , IMON , IDAY 

COMMON /NOCOL/NCOLS , NMODE 

COMMON /FACTOR/SFAC 

INTEGER*2 NCOLS 

INTEGER*2 row, rows 

INTEGER*2 DUMWIL 

RECORD/RCCOORD/S 

REAL*8 XMIN, XMAX, YMIN, YMAX, XP, YP 
CHARACTER* 6 YLO,YHI 
CHARACTER* 7 XHI 

1 FORMAT (F6. 3) 

2 FORMAT (F7. 2) 

rows = screen. numtext rows 

dummy = rectangle_w( IGBORDER, XMIN, YMIN, XMAX, YMAX ) 
row= rows/ 4 

CALL SETTEXTPOSITION(row,5,s) 

CALL OUTT EXT ( ’Gain ’) 

IF(NMODE.EQ.6) THEN 
CALL SETTEXTPOSITION (rows/2-1, 18, s) 

CALL OUTTEXT(’freq’) 

CALL SETTEXTPOSITION ( rows, 16 , s) 

ELSE 

CALL SETTEXTPOSITION( rows/2-1, 35, s) 
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IF (SFAC - EQ. 1.0) THEN 
CALL OUTTEXT( ’Frequency - rad/sec’) 

ELSE 

CALL OUTTEXTC Frequency - Hertz ’) 

ENDIF 

CALL SETT EXTPOSITION( rows, 39, s) 

ENDIF 

IF(ITYPE.EQ.l) CALL OUTTEXT(’ K(jw) ’) 

IFCITYPE.EQ.2) CALL OUTTEXT(’ K(jw,Gox) ’) 

IFCITYPE.EQ.3) CALL OUTTEXT(’ K(jw,Gf) ’) 

IFCITYPE.EQ.4) CALL OUTTEXT( ’ K( jw,Gox,Gf ) ’ ) 

WRITE (YLO , 1 )YMIN 

WRITE(YHI , 1 )YMAX 

CALL GETT EXT POSITION ( s ) 

IFCNMODE.EQ.6) THEN 

CALL SETTEXTPOSITION( 3 , 1 , S ) 

CALL OUTTEXT(YHI) 

CALL SETTEXTPOSITION(s. row-3, l,s) 

CALL OUTTEXT(YLO) 

CALL GETTEXTPOSITION(s) 

IL0C=4 

IMAX=26 

ELSEIF(NMODE.EQ. 16) THEN 
CALL SETTEXTPOSITION(3, 10,s) 

CALL OUTTEXT(YHI) 

CALL SETTEXTPOSITION(s. row-4, 10, s) 

CALL OUTTEXT(YLO) 

CALL GETTEXTPOSITION(s) 

ILOC=13 

IMAX=54 

ELSE 

CALL SETTEXTP0SITI0N(2, 10,s) 

CALL OUTTEXT(YHI) 

CALL SETTEXTPOSITIONCs. row-3, 10, s) 

CALL OUTTEXT(YLO) 

CALL GETTEXTPOSITION(s) 

ILOC=13 

IMAX=54 

ENDIF 

ILO=XMIN 

IHI=XMAX 

IDEL=IMAX/(IHI-ILO) 
row=s. row+1 
DO 21 I=ILO,IHI 
HI=10. 0**1 
WRITE(XHI ,2)HI 

CALL SETTEXTPOSIT ION ( row , I LOC , s ) 

CALL OUTTEXT (XHI) 

ILOC=ILOC+IDEL 

IF(I.EQ. ILO.OR. I. EQ. IHI) GO TO 21 
CALL SETLINESTYLE( 62268) 

XP=I 
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YP=YMIN 

CALL MOVETO_W(XP, YP,XY) 

YP=YMAX 

DUMWI L=L I NETO_W ( XP , YP ) 

CALL SETLINESTYLE( 65535) 

21 CONTINUE 
RETURN 
END 

SUBROUTINE LOWERW( XMIN, XMAX, YMAX, YMIN) 

C Sets up lower plotting window 

INCLUDE ’FGRAPH.FD’ 

INTEGER*2 dummy 

INTEGER*2 xwldth, yhelght, cols, rows 

RECORD /vldeoconf 1 g/ screen 
COMMON screen 

COMMON /NOCOL/NCOLS , NMODE 
INTEGER*2 NCOLS, NMODE 

REAL*8 XMIN, XMAX, YMIN, YMAX, XLEN, YLEN 
XLEN=0.1*(XMAX-XMIN) 

YLEN=0.1* (YMAX- YMIN) 

XMIN=XMIN-XLEN 
XMAX=XMAX+XLEN 
YMIN=YMIN-YLEN 
YMAX=YMAX+YLEN 
xwldth = screen. numxplxe Is 
yhelght = screen. numyplxe Is 
cols = screen. numtextcols 
rows = screen. numtext rows 

window 

IF(NMODE. EQ. 6) THEN 

CALL setv1ewport( 50, yhelght - 30, xwldth - 20, 10 ) 

ELSE 

CALL setv1ewport( 100, yheight - 50, xwldth - 50, 20 ) 

ENDIF 

CALL settextwindow( 0, 1, rows, cols) 
dummy = setw1ndow( .TRUE. , XMIN, YMIN, XMAX, YMAX) 

CALL c1earscreen( IGWINDOW ) 

RETURN 
END 

SUBROUTINE LOX ( S , GOX , PI PEB1 , PIPEB2 , PIPEB3 , PIPEB4 , SEGMNB , SECTNB , 
* IGONE) 

C Handles lox piping logic 

COMMON /WORKIT/WORK(12) 

COMPLEX G0X,S 

REAL AREA(75),DIA(75),L(75),PIND(75),PCAP(75) 

REAL DENS , A , L FLOW , KTANK, KMAN , OMAN , CTANK, VOL , VOLMF 
REAL PIPEB1(75) ,PIPEB2(75) ,PIPEB3(75) ,PIPEB4(75) ,PIPEB5(75) 
INTEGER SEGMNB, SECTNB( 75 ),SECTB 
CHARACTER* 2 4 LOXIN,NAMLIN(2) 

COMMON /WCAOUT/NAMLIN , IUNIT 


C - 40 


CHARACTER*20 TITLO 
CHARACTERS ANS 
DATA ISTRT/0/ 

1 FORMAT (El 5. 6) 

2 FORMAT (I5,4E15.6) 

IM0RE=0 

IF(IG0NE.EQ.2) THEN 

WRITE(*,’(A\)’)’ Is the lox line data in a file? (Y/N) ’ 

READ(», ’ (A) ’ )ANS 

IF(ANS.NE. ’N’ .AND. ANS. NE. ’n’ ) THEN 

WRITE(* , ’ (A\) ’ ) ’ Is the file with lox line data LOX.INP? (Y/N)’ 
READ(*,’(A)’)ANS 

IF(ANS.NE. ’N’ .AND. ANS. NE. ’n’) THEN 
OPEN ( UNIT= 10 , FI LE= ’ LOX . INP ’ ) 

NAMLIN(2)= ’ LOX.INP’ 

ELSE 

WRITE(* , ’ (A\) ’ ) ’ Enter name of file with lox line data ’ 
READ(*, ’ (A) ’ )LOXIN 
OPEN(10, FILE=LOXIN) 

NAMLIN(2)=LOXIN 

ENDIF 

IMORE=l 

ENDIF 

IG0NE=0 

ENDIF 

65 CONTINUE 

IF(ISTRT .EQ. O.AND. IGONE.EQ.O) THEN 
ISTRT=1 

IF(IMORE.EQ.l) GO TO 66 

CALL WORKTO( A , CMAN , CTANK , DENS , KMAN , KTANK , LFLOW , TFLOW , VOL , VOLMF , 

* PCHMB.DPROR) 

CALL MOOIFY(AREA, DIA , L , PIPEB1 , PIPEB2 ,PIPEB3, PIPEB4, PIPEB5 , 

* SECTNB , SEGMNB , SECTB , PIND , PCAP , LOPEND, LOPOLD, SPLIT , PMRAT , ’ B ’ ) 
CALL WORKFR ( A , CMAN , CTANK , DENS , KMAN , KTANK , LFLOW , TFLOW , VOL , VOLMF , 

* PCHMB.DPROR) 

IF(IUNIT.EQ.O) THEN 

WRITE(*,*) ’ You do not have any data stored, please re-read’ 
WRITE(*,*)’ the questions and answer carefully.’ 

ISTRT=0 
WRITE(*,*) ’ ’ 

GOTO 65 
ENDIF 
REWIND 10 

66 CONTINUE 

CAL L WORKTO ( A , CMAN , CTANK , DENS , KMAN , KTANK , LFLOW , TFLOW , VOL , VOLMF , 

* PCHMB,DPROR) 

CALL RLINE(TITLO, PMRAT, SEGMNB, SECTNB, PIPEB1.PIPEB2, 

* PI PEB3 , PIPEB4 , PI PEB5 , L , AREA , DI A , PIND , PCAP , LOPEND , LOPOLD , 

* SPLIT, 10) 

CALL WORKFR (A , CMAN , CTANK , DENS , KMAN , KTANK, LFLOW , TFLOW , VOL , VOLMF , 

* PCHMB.DPROR) 

WRITE(*,*) ’ For changes in lox line data enter Y,’ 
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WRITE(*, 7 (A\) ’ ) ’ if not, press enter key.’ 

READ(* , ’ (A) ’ )ANS 
WRITE(* *) ’ ’ 

IF (ANS !eQ. ’Y* .OR. ANS .EQ. ’y’) THEN 

CAL L WORKTO( A , CHAN , CTANK , DENS , KMAN , KTANK , LFLOW , TFLOW , VOL , VOLMF , 

* PCHMB , DPROR ) 

CALL MODIFY( AREA , DIA , L , PIPEB1 , PIPEB2 , PIPEB3 , PIPEB4, PIPEB5 , 

* SECTNB , SEGMNB , SECTB , PIND , PCAP , LOPEND, LOPOLD , SPLIT , PMRAT , ’B’) 

CAL L WORKFR ( A , CMAN , CTANK , DENS , KHAN , KTANK , LFLOW , T FLOW , VOL , VOLHF , 

* PCHMB, DPROR) 

ENDIF 

RETURN 

ELSEIF(ISTRT .EQ. 1 . AND. IGONE. EQ.O) THEN 
CALL ADMIT ( S , GOX , A , AREA , CMAN , CTANK , DPROR , L , LFLOW , PMRAT , SEGMNB, 

* SECTNB, SPLIT, LOPEND, PCAP, PIND) 

ELSEIFUSTRT.EQ.l. AND. IGONE. EQ.l) THEN 

WRITE(», ’ (A\) ’ ) ’ Do you wish to modify current LOX line data? ’ 
READ(*, ’ (A) ’ )ANS 

IF(ANS .EQ. ’Y’ .OR. ANS .EQ. ’y’) THEN 

CALL WORKTO( A , CMAN , CTANK , DENS , KMAN , KTANK, LFLOW , TFLOW , VOL , VOLMF , 

* PCHMB, DPROR) 

CALL MODI FY( AREA , DIA , L , PIPEB1 , PIPEB2 , PIPEB3 , PIPEB4 , PI PEB5 , 

* SECTNB , SEGMNB , SECTB , PIND , PCAP , LOPEND, LOPOLD, SPLIT , PMRAT , ’ B ’ ) 
CALL WORKFR( A , CMAN , CTANK , DENS , KMAN , KTANK , LFLOW , TFLOW , VOL , VOLMF , 

* PCHMB, DPROR) 

ELSE 

WRITE(», ’ (A\) ’ ) ’ Do you wish to rewind LOX line file? ’ 

READ(*, ’ (A) ’ )ANS 

IF(ANS .EQ. ’Y’ .OR. ANS .EQ. ’y’) REWIND 10 

CALL WORKTO ( A , CMAN , CTANK , DENS , KMAN , KTANK, LFLOW , TFLOW , VOL , VOLMF , 

* PCHMB, DPROR) 

CALL RLINECTITLO, PMRAT, SEGMNB, SECTNB, PIPEB1 ,PIPEB2 , 

* PIPEB3 , PIPEB4 , PIPEB5 , L , AREA , DIA , PIND, PCAP , LOPEND , LOPOLD , 

* SPLIT, 10) 

CALL WORKFR ( A , CMAN , CTANK , DENS , KMAN , KTANK , LFLOW , TFLOW , VOL , VOLMF , 

* PCHMB, DPROR) 

WRITE(*,*)’ For changes In lox line data enter Y,’ 

WRITE(*, ’ (A\) ’ ) ’ if not, press enter key.’ 

READ(*, ’ (A) ’ )ANS 
WRITER,*)’ ’ 

IF(ANS .EQ. *Y f .OR. ANS .EQ. ’y’) THEN 

CALL WORKTO ( A , CMAN , CTANK , DENS , KMAN , KTANK , LFLOW , T FLOW , VOL , VOLMF , 

* PCHMB, DPROR) 

CALL MODIFY( AREA, DIA , L , PIPEB1 , PIPEB2 , PIPEB3, PIPEB4 , PIPEB5 , 

* SECTNB , SEGMNB , SECTB , PIND , PCAP , LOPEND, LOPOLD, SPLIT , PMRAT , ’ B ’ ) 
CALL WORKFR ( A , CMAN , CTANK , DENS , KMAN , KTANK , L FLOW , T FLOW , VOL , VOLMF , 

* PCHMB, DPROR) 

ENDIF 

ENDIF 

IGONE=0 

ENDIF 

RETURN 
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ENO 

SUBROUTINE MODIFY( AREA , DIA , L , PIPE1 , PIPE2 , PIPE3 , PIPE4 , PIPE5 , SECTN , 

* SEGMN , SECT , PIND , PCAP , LOPEND, LOPOLD, SPLIT , PMRAT , R) 

C Allows modifications to input data 

REAL AREA(75) , DIA(75) , L(75) , PIPE1(75) ,PIPE2(75) ,PIPE3(75) , 

* PIPE4(75) ,PIPE5(75) , PIND(75) ,PCAP(75) 

REAL KMAN,KTANK,LFLOW 

INTEGER*2 SECTN ( 75 ), SECT, SEGMN 

COMMON /WORKIT/A , CMAN , CTANK , DENS , KHAN , KTANK , LFLOW , TFLOW , VOL , 

* VOLMF , PCHMB , DPROR 

PMARAPTPRftl A NC p 

CHARACT ER*8 VARVAL ( 9 ) , VARU ( 9 ) , VARL ( 9 ) , NAME 
CHARACTERS NAMLIN(2) 

COMMON /WCAOUT/NAMLIN , IUNIT 

CHARACTER*40 TITLE 

CHARACTER* 20 TITLF 

INTEGER*2 I HR , IMIN , IYR , IMON , IDAY 

CHARACTER*2 AP 

COMMON /WCATIT/TITLE , TITLF , IHR , IMIN , AP , IYR , IMON , IDAY 
DATA GRAV/32. 2/, PI/3. 141593/ 


DATA VARVAL/’ DENS 

=’,’ DPROR 

=’,’ KMAN = 

> 

j 

* ’ KTANK 

=’,’ LFLOW 

=’,’ PCHMB = 

’ , ’ TFLOW = ’ , 

* ’ VOL 

=’,’ VOLMF 

= 7 


DATA VARU/ ’DENS 

, ’ DPROR 

’,’KMAN », 


* ’KTANK 

, ’LFLOW 

’, ’PCHMB ’, 

’TFLOW 

* ’VOL 

, ’VOLMF 

7 


DATA VARL/ ’dens ’ 

, ’dpror 

’ , ’ kman ’ , 


* ’ktank ’ 

,’lflow 

’ , ’ pchmb ’ , 

’ tf low ’, 

n 

< 

o 

, ’ volmf 

7 



1 FORMAT ( 1PE15. 6) 

2 FORMAT(I5, 1P5E15.6) 

3 FORMAT(I5, 1P3E15. 6) 

4 FORMAT(’ This segment is a bend of ’ ,1PE13.5, ’ deg and radius of’, 

* E13.5) 

5 FORMAT ( ’ This segment Is straight ’,1PE13.5,’ diameter pipe ’, 

* E13.5, ’ ft. long’) 

6 FORMAT(A8,1PE13.5,10X,A8,E13.5) 

7 FORMAT (’ TITLE = ’ ,A20) 

10 FORMAT(A20,2X,I2.2, ’,I2.2,A2,3X,I2.2, ,12.2, ,12.2) 

11 FORMAT ( ’ This segment Is ’,12,’ way split ’,1PE13.5,’ dla.’, 

* ’ pipe ’ , E13.5, ’ ft. long’) 

12 FORMAT ( ’ This segment Is a pump with length =’,1PE13.5,’ dla =’, 

* E13.5/5X, ’dp/dm =’,E13.5,’ capacitance =’,E13.5, 

* ’ Inductance =’,E13.5) 

13 FORMAT ( ’ This segment is a tuned pipe ’,1PE13.5,’ long & dla = ’, 

* E13.5) 

14 FORMAT (’ This segment Is a Helmholtz resonator with ’/5X, ’ length =’ 

* , 1PE13.5, ’ dla = ’ , E13. 5, ’ and vol =’,E13.5) 

15 FORMAT(’ This segment Is a parallel resonator with ’/5X, ’ length = ’, 

* 1PE13.5,’ dla = ’ ,E13.5, ’ and vol =’,E13.5) 

16 FORMAT(’ This segment Is a’,lPE13.5,’ long Inline acc. with’, 

* ’ diameter of’,E13.5) 
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IF(R.EQ. ’A’) THEN 
IUNIT=11 
NAMNAH= 1 
ELSE 

IUNIT=10 
NAMNAM= 2 
ENDIF 

AVGK=0 . 5* ( KTANK+KMAN ) 

ICHG=0 

WRITE(*,*)’ Do you wish to change engine * fluid parameters ’ 
READ(*,’(A)’)ANS 

IF(ANS.NE. ’Y’.AND.ANS.NE. ’y’) GO TO 29 

WRITE(*,*)’ Do you wish to change all of the parameters?’ 

READ(*,’(A)’)ANS 

IF(ANS.NE. ’Y’.AND.ANS.NE. ’y’) ICHG=1 

21 CONTINUE 
IF(ICHG.EQ.O) THEN 

WRITE(*, ’ (A\) ’ ) ’ Enter TITLE (20 characters max.) ’ 

READ(», ’ (A) ’ )TITLF 

WRITE (TITLE, 10 )TITLF, IHR,IMIN,AP,IMON,IDAY,IYR 
WRITE(*, ’ (A\) ’ ) ’ Enter FUEL TANK VOLUME (ft"3)’ 

READ(*,*)VOL 

WRITE(* , ’ (A\) ’ ) ’ Enter FLOW RATE Inside LINE (lbm/sec)’ 
READ(*,*)LFLOW 

WRITE(*, ’ (A\) ’ ) ’ Enter BULK MODULUS of fluid Inside TANK (lb /ft" 
* 2 ) ’ 

READ(*,*)KTANK 

WRITE(* , ’ (A\) ’ ) ’ Enter FUEL DENSITY (lbm/ft~3)’ 

READ (*,*) DENS 

WRITE(* , ’ (A\) ’ ) ’ Enter TOTAL FLOW RATE Inside ENGINE (lbm/sec)’ 
READ(*,*)TFLOW 

WRITE(*, ’ (A\) ’ ) ’ Enter MANIFOLD VOLUME (ft"3)’ 

READ(*,*)VOLMF 

WRITE(*, ’ (A\) ’ ) ’ Enter BULK MODULUS of fluid inside MANIFOLD (lb 
*/ft"2) ’ 

READ(*,*)KMAN 

WRITE(*, ’ (A\) ’ ) ’ Enter CHAMBER PRESSURE in ENGINE (lbf/ft"2)’ 
READ(*,*)PCHMB 

WRITE(*, ’ (A\) ’ ) ’ Enter PRESSURE DROP across ORIFICE (lbf/ft"2)’ 

READ(*,*)DPROR 

A= SORT ( GRAV* KTAN K/DENS ) 

CTANK=DENS«VOL/KTANK 
CMAN= DENS*VOLMF/KMAN 
PMRAT=PCHMB/TFLOW 
AVGK=0. 5* (KTANK+KMAN) 

ELSE 

GO TO 24 

22 CONTINUE 

WRITE(*,*)’ VARIABLE NAMES AND DESCRIPTIONS’ 

WRITE(*,*) ’ ’ 

WRITE(*,*)’ TITLE - title (20 characters max.) 

WRITE(*,*) ’ DENS - density of fluid (lbm/ft"3) 
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WRITEC*,*)’ DPROR - pressure drop across orflces (lbf/ft'2)’ 

WRITEC*,*) ’ KHAN - bulk modulus In manifold (lbf/ft~2) 

WRITEC*,*)’ KTANK - bulk modulus In tank (lbf/ft~2) 

WRITEC*,*)’ LFLOW - mass flow rate of fluid (lbm/sec) ’ 

WRITEC*,*)’ PCHMB - chamber pressure (lbf/ft^2) * 

WRITEC*,*)’ TFLOW - total mass flow Inside engine (lbm/sec)’ 

WRITEC*,*) ’ VOL - volume of storage tank (ft^3) ’ 

WRITE (*,*) ’ VOLMF - volume of manifold (ft~3) ’ 

WRITEC*,*)’ ’ 

GO TO 25 

23 CONTINUE 

WRITE (*,*)’ VARIABLE NAMES AND VALUES’ 

WRITEC*,*)’ ’ 

WRITEC* , 7 )TITLF 

WRITEC*, 6 )VARVAL( 1), DENS.VARVALC 2), DPROR, 

* VARVALC 3), KMAN,VARVAL( 4 ) , KTANK , VARVAL ( 5), LFLOW, 

* VARVALC 6), PCHMB, VARVALC 7) , TFLOW, VARVALC 8), VOL, 

* VARVALC 9), VOLMF 

24 CONTINUE 
WRITEC*,*)’ ’ 

WRITEC*,*)’ Enter ? to print variable names & descriptions’ 

WRITEC*,*)’ # to print variable names & values’ 

WRITEC*,*)’ TITLE to enter new title’ 

WRITEC*,*)’ END when all changes have been made’ 

WRITEC*,*)’ ’ 

25 CONTINUE 

WRITEC*, ’ (A\) ’) ’ Enter variable name and new value, END, ?, or 

* « ’ 

CALL ZREADCNAME, VALUE) 

IFCNAME.EQ. ’?’) GO TO 22 

IFCNAME.EQ.’#’) GO TO 23 

IFCNAME.EQ. ’END’. OR. NAME. EQ. ’end’) GO TO 28 
IFCNAME.EQ. ’TITLE’ .OR. NAME. EQ. ’title’) THEN 
WRITEC*, ’ (A\) ’) ’ Enter new TITLE C20 characters max.) ’ 

READC*, ’ (A) ’ )TITLF 

WRITE (TITLE, 10)TITLF, IHR, IMIN.AP, IMON.IDAY, IYR 
GO TO 25 
ENDIF 

DO 26 11=1,9 
I=II 

IF(NAME. EQ. VARU(I).OR.NAME. EQ. VARL(I)) GO TO 27 

26 CONTINUE 

WRITEC*,*)’ Invalid name, try again’ 

GO TO 22 

27 CONTINUE 

IFCI.EQ. 1) DENS=VALUE 
IFCI.EQ. 2) DPROR=VALUE 
IFCI.EQ. 3) KMAN=VALUE 
IFCI.EQ. 4) KTANK= VALUE 
IFCI.EQ. 5) LFLOW=VALUE 
IFCI.EQ. 6) PCHMB= VALUE 
IFCI.EQ. 7) TFLOW=VALUE 
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IF(I.EQ. 8) VOL=VALUE 
IF(I.EQ. 9) VOLMF=VALUE 
GO TO 25 
ENDIF 

28 CONTINUE 

A=SQRT ( GRAV*KTANK/DENS ) 

CTANK=OENS*VOL/KTANK 
CMAN=DENS*VOLMF/KMAN 
PMRAT=PCHMB/TFLOW 
AVGK=0. 5* ( KTANK+KMAN ) 

29 CONTINUE 
ICHG=0 

WRITE (*,*)’ Do you wish to change the pipe layout? ’ 

READ(*, ’ (A) ’ )ANS 

IF(ANS.NE. ’Y' . AND. ANS.NE. ’y ’ ) GO TO 36 

WRITE(*,*)’ Do you wish to change all of the pipe segments?’ 
READ(* f ’ (A) ’ )ANS 

IF(ANS.NE. ’Y* . AND.ANS.NE. ’y ’ ) THEN 
ICHG=1 
GO TO 30 
ENDIF 
SPLIT=1.0 
L0PEND=1 
L0P0LD=20 

WRITE(», ’ (A\) ’ ) ’ How many segments is the pipe broken Into? ’ 
READ(*,*)SEGMN 

30 CONTINUE 
1=0 

ISEGMN=SEGMN 
DO 35 11=1 ,SEGMN 
1=1+1 

IF(ICHG.EQ.l) THEN 
I F ( SECTN ( I ) . EQ . 0 ) THEN 
WRITE(*,4)PIPE2(I),PIPE1(I) 

ELSEIF(SECTN(I).EQ.l) THEN 
WRITE(*,5)PIPE2(I),PIPE1(I) 

ELSEIF(SECTN(I) . EQ. 2) THEN 
WRITE (*, 16)PIPE1(I) ,PIPE2(I) 

ELSEIF(SECTN(I) . EQ. 3) THEN 
WRITE(*,13)PIPE1(I),PIPE2(I) 

ELSEIF(SECTN(I) . EQ.4) THEN 
WRITE(*, 14)PIPE1(I) ,PIPE2(I) ,PIPE3(I) 

ELSEIF(SECTN(I) . EQ. 5) THEN 
WRITE (*, 15)PIPE1(I) ,PIPE2(I) ,PIPE3(I) 

ELSEIF(SECTN(I) . EQ. 6) THEN 

WRITE(*, 12)PIPE1(I) ,PIPE2(I) ,PIPE3(I) ,PIPE4(I) ,PIPE5(I) 
ELSEIF(SECTN(I) . EQ. 9) THEN 
WRITE(*,11)INT(PIPE3(I)),PIPE2(I),PIPE1(I) 

ENDIF 

WRITE(*,*)’ You may keep (K), modify (Y), delete (D),’, 

* ’ add before (B), or add after (A)?’ 

READ(*, ’ (A) ’ )ANS 
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IF(ANS. EQ. ’A’.OR.ANS.EQ. ’a’) THEN 
1 = 1+1 

DO 31 III=ISEGMN, I ,-l 
PIPE1(III+1)=PIPE1(III) 

PIPE2 (III+1) = PIPE2 C 1 1 1 ) 

PIPE3 (II 1+1 ) =PIPE3 (III) 
PIPE4(III+1)=PIPE4(III) 
PIPE5(III+1)=PIPE5(III) 
L(III+1)=L(III) 

DIA(III+1)=DIA(III) 

AREA(III+1)=AREA(III) 

PCAP(III+1)=PCAP(III) 

PIND(III+1)=PIND(III) 

SECTN(III+1)=SECTN(III) 

31 CONTINUE 

ISEGMN=ISEGMN+1 
GO TO 34 

ELSEIF(ANS.EQ. ’B’.OR.ANS.EQ. ’b’) THEN 
DO 32 III=ISEGMN, I ,-l 
PIPE1(III+1)=PIPE1(III) 
PIPE2(III+1)=PIPE2(III) 
PIPE3(III+1)=PIPE3(III) 
PIPE4(III+1)=PIPE4(III) 
PIPE5(III+1)=PIPE5(III) 
L(III+1)=L(III) 

DIA(III+1)=DIA(III) 

AREA (III+1)= AREA (III) 
PCAP(III+1)=PCAP(III) 
PIND(III+1)=PIND(III) 
SECTN(III+1)=SECTN(III) 

32 CONTINUE 

ISEGMN=ISEGMN+1 
GO TO 34 

ELSEIF(ANS. EQ. ’D’ .OR.ANS.EQ. ’d’) THEN 
DO 33 III=I , ISEGMN 
PIPE1(III)=PIPE1(III+1) 
PIPE2(III)=PIPE2(III+1) 
PIPE3(III)=PIPE3(III+1) 
PIPE4(III)=PIPE4(III+1) 

PIPE5(III )=PIPE5(III+1) 
L(III)=L(III+1) 

DIA(III)=DIA(III+1) 

AREA(III)=AREA(III+1) 

PCAP(III )=PCAP(III+1) 
PIND(III)=PIND(III+1) 
SECTN(III)=SECTN(III+1) 

33 CONTINUE 

1 = 1-1 

ISEGMN=ISEGMN-1 
GO TO 35 

ELSEIF(ANS.NE. ’Y’ . AND.ANS.NE. ’y’) THEN 
GO TO 35 
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ENDIF 

ENDIF 

34 CONTINUE 

WRITE(*,*) ’ Specify 0 for BEND, 1 for STRAIGHT pipe,’ 

WRITE(*,*) ’ 2 for INLINE ACCUM. , 3 for TUNED STUB,’ 

WRITE(», *) ’ 4 for HELMHOLTZ RES., 5 for PARALLEL RES.’ 

WRITE(*,*)’ 6 for PUMP, 9 for SPLIT’ 

READ(*, *) SECT 

I F (SECT . LT . 0 . OR . SECT . GT . 6 . AND . SECT . NE . 9 ) GO TO 34 
SECTN(I)=SECT 
IF(SECT.EQ.O) THEN 
C BEND IN PIPE 

WRITE(*,*) ’ RADIUS of bend along CL (ft), ANGLE of bend (deg),’ 
WRITE(*,*) ’ DIAMETER (ft), and LENGTH (ft) beyond bend of pipe’ 
READ(*,*)PIPE1(I) ,PIPE2(I) ,PIPE3(I) ,PIPE4(I) 

CALL BENDS( PIPE1 ( I ) , PIPE2 ( I ) , PIPE3( I ) , PIPE4( I ) , VALUE , DIME ) 
AREAB=0. 785398*DIME**2 
L( I )=VALUE 
AREA( I )=AREAB 
DIA(I)=DIME 
PIPE5(I)=0.0 
ELSEIF(SECT.EQ.l) THEN 
C STRAIGHT SECTION 

WRITE(*,*) ’ Specify LENGTH (ft) and DIAMETER (ft) of segment’ 
READ(*,*) PIPEl(I) ,PIPE2(I) 

VALUE=PIPE1(I) 

DIME=PIPE2(I) 

PIPE3(I)=0.0 

PIPE4(I)=0.0 

PIPE5(I)=0. 0 

AREAB=0. 785398*DIME**2 

L(I)=VALUE 

AREA(I)=AREAB 

DIA( I )=DIME 

ELSEIF(SECT. EQ. 2) THEN 
C INLINE ACCUMULATOR 

WRITE(*,*)’ Specify LENGTH (ft) & DIAMETER (ft) of accumulator ’ 
READ(*,*) PIPEl(I) ,PIPE2(I) 

L(I)=PIPE1(I) 

DIA(I)=PIPE2(I) 

AREA(I)=0.25*PI*PIPE2(I)»*2 

PCAP(I)=DENS*0.785398*L(I)*DIA(I)**2*PMRAT/AVGK 
PIPE3(I)=0.0 
PIPE4(I)=0.0 
PIPE5(I)=0. 0 
ELSEIF(SECT. EQ. 3) THEN 
C TUNED STUB ACCUMULATOR 

WRITE(*,*)’ Specify LENGTH (ft) & DIAMETER (ft) of tuned stub’ 
READ(*,*)PIPE1(I) ,PIPE2(I) 

L(I)=PIPE1(I) 

DIA(I)=PIPE2(I) 

AREA(I)=0.25«PI*PIPE2(I)**2 
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PCAP(I)=DENS*L( I )*AREA( I )*PMRAT/AVGK 
PIND(I)=L(I)/(AREA(I)*GRAV*PMRAT) 

PIPE3(I)=0.0 
PIPE4(I)=0.0 
PIPE5(I)=0.0 
ELSEIF(SECT. EQ. 4) THEN 

HELMHOLTZ RESONATOR ACCUMULATOR 

WRITE(*,*)’ Specify LENGTH (ft), DIAMETER (ft) .VOLUME (ft^3) ’ , 

’ of Helmholtz Resonator’ 
READ(*,*)PIPE1(I),PIPE2(I),PIPE3(I) 

L( I )=PIPE1 (I ) 

DIA(I)=PIPE2(I) 

AREA(I)=PIPE3(I) 

PCAP ( I ) = DENS* L ( I ) * AREA ( I )*PMRAT/AVGK 
PIND(I)=L(I)/(0.25*PI*DIA(I)**2*GRAV*PMRAT) 

PIPE4(I)=0.0 
PIPE5(I)=0.0 
ELSEIF(SECT. EQ. 5) THEN 

PARALLEL RESONATOR ACCUMULATOR 

WRITE (*,*)’ Specify LENGTH (ft), DIAMETER (ft) .VOLUME (ft~3)’, 

’ of Parallel Resonator’ 

READ(*,*)PIPE1(I) ,PIPE2(I) ,PIPE3(I) 

L(I)=PIPE1(I) 

DIA(I)=PIPE2(I) 

AREA(I)=PIPE3(I) 

PCAP ( I ) = DENS*L( I ) *AREA( I )*PMRAT/AVGK 
PIND(I)=L(I)/(0.25*PI*DIA(I)**2*GRAV*PMRAT) 

PIPE4(I)=0.0 
PIPE5(I)=0.0 
ELSEIF(SECT. EQ. 6) THEN 
PUMP 

WRITE(*,*) ’ Specify LENGTH (ft), DIAMETER (ft) , dp/dm, CAP.’, 

’ & IND. of pump’ 

READ(* , *)PIPE1(I ) , PIPE2(I) ,PIPE3(I ) ,PIPE4(I ) ,PIPE5( I ) 
L(I)=PIPE1(I) 

DIA(I)=PIPE2(I) 

AREA(I)=PIPE3(I) 

PCAP(I)=PIPE4(I) 

PIND(I)=PIPE5(I) 

ELSEIF(SECTN(I) . EQ. 9) THEN 
SPLIT PIPE 

WRITE(*,*) ’ Specify LENGTH (ft), DIAMETER (ft), and no. of’, 

’ segments’ 

READ(*,*) PI PEI (I) ,PIPE2(I) ,PIPE3(I) 

VALUE=PIPE1(I) 

DIME=PIPE2(I) 

SPLIT=PIPE3(I) 

WRITE(*, ’ (A, 13) ’ ) ’ Maxlmun no. of Iterations Is set at ’,LOPOLD 
WRITE(*, ’ (A\) ’ ) ’ Do you wish to change It? ’ 

READ(*, ’ (A) ’ )ANS 

IF(ANS. EQ. ’Y’ .OR.ANS.EQ. ’y’) THEN 
WRITE(*, ’ (A\) ’ ) ’ Enter maximum no. of iterations ’ 


READ(*,*)LOPOLD 

ENDIF 

LOPEND=LOPOLD 
AREAB=0 . 785398*DIME**2 
L(I)=VALUE 
AREA(I)=AREAB 
DIA(I)=DIME 
PIPE4( I )=0. 0 
PIPE5(I)=0.0 
ENDIF 

35 CONTINUE 
IF(ICHG.EQ.O) THEN 

WRITE(*,*)’ NEW PIPE LAYOUT’ 

WRITE(*,*)’ STATUS LENGTH AREA DIAMETER’ 

DO 351 11=1 ,SEGMN 

WRITE(*,3)SECTN(I),L(I),AREA(I),DIA(I) 

351 CONTINUE 
ENDIF 

SEGMN=ISEGMN 

36 CONTINUE 

WRITE(*, ’ (A\) ’ ) ’ Do you wish to save these changes? Y or N ’ 
READ(*, ’ (A) ’ )ANS 

IF(ANS.NE. ’Y’.AND.ANS.NE. ’y’) RETURN 

WRITE (*, ’ (A,A,A\) ’ ) ’ Do you wish to use file ’ ,NAMLIN(NAMNAM) , 

* ’? Y or N ’ 

READ(* , ’ (A) ’ )ANS 

IF(ANS.NE. ’Y’.AND.ANS.NE. ’y’ ) THEN 
WRITE(*, ’ (A\) ’ ) ’ Enter name of file to use ’ 

READ(*, ’ (A) ’ )NAMLIN(NAMNAM) 

CLOSE (UNIT=IUNIT) 

OPEN(UNIT= I UNIT , FILE=NAMLIN(NAMNAM) ) 

ELSE 

WRITE(* , ’ (A, A,A\) ’ ) ’ Do you wish to rewind ’ ,NAMLIN(NAMNAM) , 

* ’? Y or N ’ 

READ(* , ’ (A) ’ )ANS 

IF(ANS.EQ. ’Y’.OR.ANS.EQ. ’y’) REWIND IUNIT 
ENDIF 

WRITE(IUNIT, ’(A)’)TITLF 
WRITE( IUNIT , 1 )VOL 
WRITE( IUNIT, l)LFLOW 
WRITE( IUNIT, 1)KTANK 
WRITE( IUNIT, 1)DENS 
WRITE(IUNIT,l)TFLOW 
WRITE(IUNIT,l)VOLMF 
WRITE( IUNIT, 1)KMAN 
WRITE( IUNIT, DPCHMB 
WRITE( IUNIT, l)DPROR 
WRITE( IUNIT , 2 )SEGMN 

WRITE(IUNIT,2) (SECTN(I) ,PIPE1(I) ,PIPE2(I) ,PIPE3(I ) , PIPE4(I ) , 

* PIPE5 ( I ) , I = 1 » SEGMN ) 

RETURN 

END 
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SUBROUTINE NICEGRF(RMIN , RMAX , IHAX , IMMIN , ITYPE ) 

C Plots Nyquist curve 

INCLUDE ’ FGRAPH. FD’ 

RECORD /videoconf ig/ screen 
COMMON screen 

CHARACTER*40 TITLE 
CHARACTER* 20 TITLF 
INTEGER*2 IHR, IMIN, IYR, IMON, IDAY 
CHARACTER* 2 AP 

COMMON /WCATIT/TITLE, TITLF, IHR, IMIN,AP, IYR, IMON, IDAY 
COMMON /NOCOL/NCOLS , NMODE 
COMMON /FACTOR/SFAC 
INTEGER*2 NCOLS, NMODE 
INTEGER*2 row, rows 
RECORD/RCCOORD/S 
REAL*8 IMMIN, IMAX.RMIN, RMAX 
REAL*8 XMIN, XMAX, YMIN, YMAX 
CHARACTER*6 YLO,YHI ,XL0,XHI 
1 FORMAT (F6. 3) 

rows = screen. numtextrows 

XMIN=RMIN 

XMAX=RMAX 

YMIN= IMMIN 

YMAX=IMAX 

IF(NMODE. EQ. 6) THEN 
CALL settextpos1t1on( 0, 1, s) 

CALL OUTTEXT(TITLE) 

ELSE 

CALL settextpos1t1on( 0, 20, s) 

CALL OUTTEXT (TITLE) 

ENDIF 

dummy = rectangle_w( $GBORDER , XMIN, YMIN, XMAX, YMAX ) 
row= rows/ 2 

CALL SETTEXTPOSITION( row, 1 , s) 

IF(NMODE.EQ.6) THEN 
CALL OUTTEXT (’Imag’) 

CALL SETTEXTPOSITION( rows-1 , 16,s) 

CALL OUTTEXT (’ Real’) 

CALL SETTEXTPOSITION( rows, 16,s) 

ELSE 

CALL OUTTEXT (’ Imaginary’) 

CALL SETTEXTPOSIT ION ( rows-1 , 39 , s) 

CALL OUTTEXT (’ Real’) 

CALL S ETTEXT POSITION ( rows, 39 , s) 

ENDIF 

IF( ITYPE. EQ.l) CALL OUTTEXT(’ K(jw) ’) 

IF(ITYPE. EQ. 2) CALL OUTTEXT(’ K(jw,Gox) ’) 

IF( ITYPE. EQ. 3) CALL OUTTEXTC K(jW,Gf) ’) 

IF(ITYPE. EQ. 4) CALL OUTTEXT( ’ K( jw,Gox,Gf ) ’ ) 

WRITE(YLO, 1 )YMIN 
WRITE(YHI , 1 )YMAX 
WRITE (XLO, 1) XMIN 
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WRITE ( XHI , 1)XMAX 
CALL GETTEXTPOSITION(s) 

IF(NMODE.EQ.6) THEN 
CALL SETTEXTPOSITION(s. row-3, l,s) 

CALL OUTTEXT(YLO) 

CALL GETTEXTPOSITION(s) 

CALL SETTEXTPOSIT ION ( S . row+1 , 4 , s ) 

CALL OUTTEXT(XLO) 

CALL GETTEXTPOSITION(s) 

CALL SETTEXTPOSITION(s. row, 35, s) 

CALL OUTTEXT(XHI) 

CALL SETTEXTPOSITION(3, 1 ,s) 

CALL OUTTEXT(YHI) 

ELSE 

CALL SETTEXTPOSITION(s. row-3, 5, s) 

CALL OUTTEXT(YLO) 

CALL GETTEXTPOSITION(s) 

CALL SETTEXTPOSITION(s. row+1 , 9, s) 

CALL OUTTEXT (XLO) 

CALL GETTEXTPOSITION(s) 

CALL SETTEXTPOSITION(s. row, 71 , s) 

CALL OUTTEXT (XHI) 

CALL SETTEXTPOSIT ION (2, 5, s) 

CALL OUTTEXT (YH I) 

ENDIF 

RETURN 

END 

SUBROUT I N E N YQU I S ( GF , GOX , S , TAUT , CSTAR , RBAR , DCDR , THETAC , K, KIR, K2R, 
*K3R , K4R , K1C , K2C , K3C , K4C , I FUEL , ILOX) 

C Computes the K()’s 

COMPLEX GF , GOX , KG1 , KG2 , KG3 , KG4 , S 
REAL THETAC, RBAR, CSTAR, DCDR, TAUT 

REAL K1R( 1001 ), K2R( 1001 ), K3R(1001) ,K1C( 1001 ),K2C( 1001 ),K3C( 1001) 
REAL K4R( 1001 ) , K4C(1001 ) 

KG1=2 . 0*CEXP(-S*TAUT)/(THETAC*S +1.0) 

K1C(K)=AIMAG(KG1) 

K1R(K)=REAL(KG1) 

IF(ILOX.EQ.O) THEN 

KG2 = 0 . 5 * KG 1 * ( ( 1 . 0+ ( 1 . 0+ R BAR ) * DCDR/CST AR ) *GOX ) 

K2C( K)=AIMAG( KG2 ) 

K2R(K)=REAL(KG2) 

ENDIF 

IF(IFUEL.EQ.O) THEN 

KG3=0 . 5*KG1*( ( 1 . 0-RBAR*( 1 . 0+RBAR)*DCDR/CSTAR)*GF) 
K3C(K)=AIMAG(KG3) 

K3R(K)=REAL(KG3) 

ENDIF 

IF( ILOX. EQ.O. AND. IFUEL.EQ.O) THEN 
KG4=KG2+KG3 
K4C ( K ) = AIMAG ( KG4 ) 

K4R(K)=REAL(KG4) 

ENDIF 
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RETURN 

END 

SUBROUTINE PIPPLOT ( SEGHN , SECTN , PIPE1 , PIPE2 , PIPE3 , PIPE4 , I LOX , R) 

C Supervises plot of piping layout 

INCLUDE ’ FGRAPH. FD’ 

RECORD/WXYCOORD/XY 
INTEGER*2 DUMWIL 

COMMON /ARCCON/XC , YC , RAD , ANG , ANGLE 

COMMON /PI PPXY/X , XH , XL , Y , YH , YL , XMIN , XMAX , YMIN , YMAX , SINA , COSA 
INTEGERS SEGMN , SECTN ( 75 ) , ITYPE ( 200 ) 

REAL PIPE1(75) , PIPE2(75) , PIPE3(75) ,PIPE4(75) 

REAL*8 X0,X1,X2,X3,Y0,Y1,Y2,Y3 
REAL POINT (8, 200) 

CHARACTER* 1 R 
ANG=0. 0 
ANGLE=0. 0 
COSA= 1 . 0 
SINA=0. 0 
X=0.0 
XH=0. 0 
XL=0. 0 
Y=0. 0 

IF(SECTN(1) . EQ.O) THEN 
YH=Y+0. 5*PIPE3(1) 

YL=Y-0. 5*PIPE3(1) 

ELSEIF(SECTN(1) .GE.3. AND.SECTN(l) .LE.5) THEN 
IF(SECTN(2).EQ.O) THEN 
YH=Y+0.5*PIPE3(2) 

YL=Y-0. 5*PIPE3(2) 

ELSE 

YH=Y+0.5*PIPE2(2) 

YL=Y-0.5*PIPE2(2) 

ENDIF 

ELSE 

YH=Y+0 . 5*PIPE2 (1 ) 

YL=Y-0. 5*PIPE2(1) 

ENDIF 

J=0 

XMIN=0.0 
XMAX=0. 0 

YMIN=AMIN1(Y, YL , YH) 

YMAX= AMAX1 ( Y , YL , YH ) 

DO 21 1=1, SEGMN 
IF(SECTN(I). EQ.O) THEN 
C BEND 

CALL BNSECT ( J , ITYPE , POINT , PIPE1 ( I ) , PIPE2 ( I ) , PIPE3 (I ) , PIPE4(I ) ) 
ELSEIF( SECTN d ) . EQ. 1 . OR. SECTN ( I ) . EQ. 9) THEN 
C STRAIGHT SECTION 

CALL STSECT ( J , ITYPE , POINT , PIPE1 (I ) , PIPE2 (I ) ) 

ELSEIF(SECTN(I) . EQ. 2) THEN 
C INLINE ACCUMULATOR 

CALL STSECT (J , ITYPE , POINT , PIPE1 ( I ) , PIPE2 (I)) 
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ELSEIF(SECTN(I) . EQ.3) THEN 
C TUNED STUB ACCUMULATOR 

CALL TSSECT ( J , ITYPE , POINT , PIPE1 ( I ) , PIPE2 (I)) 
ELSEIF(SECTN(I ) . EQ. 4) THEN 
C HELMHOLTZ RESONATOR 

CALL HHSECT ( J , ITYPE , POINT , PIPE1 ( I ) , PIPE2( I ) , PIPE3 ( I ) ) 
ELSEIF(SECTN(I) . EQ.5) THEN 
C PARALLEL RESONATOR 

CALL PLSECT(J, ITYPE, POINT, PIPEl(I) ,PIPE2(I) ,PIPE3(I) ) 
ELSEIF(SECTN(I).EQ.6) THEN 
C PUMP 

CALL STSECT ( J , ITYPE , POINT , PIPE1 (I ) , PIPE2 (I ) ) 

ENDIF 

21 CONTINUE 

XRANGE=XMAX-XMIN 

YRANGE=YMAX-YMIN 

XMIN=XMIN-0 . 05*XRANGE 

XMAX=XMAX+0. 05*XRANGE 

YMIN=YMIN-0.05*YRANGE 

YMAX=YMAX+0. 05*YRANGE 

CALL UPPERW ( XM I N , YM I N , XM AX , YMAX , I LOX , R ) 

DO 24 1=1, J 

IF(ITYPE(I) . EQ.O) THEN 
C BEND 

XC=POINT (1,1) 

YC=POINT(2,I) 

Xl=POINT(3, I) 

Yl=POINT(4, I) 

RAD=POINT(5,I) 

IF(Xl.GT.Yl) THEN 
Xl=3. 14159+X1 
Yl=3. 14159+Y1 
CALL CURV(Y1,X1) 

ELSE 

CALL CURV(Xl.Yl) 

ENDIF 

ELSE 

C ALL EXCEPT BEND 

XO=POINT (1,1) 

YO=POINT(2 , I) 

Xl=POINT(3,I) 

Yl=POINT(4,I) 

X2=POINT(5 , I ) 

Y2=POINT(6,I) 

X3=POINT(7,I) 

Y3=POINT(8,I) 

CALL MOVETO_W(XO,YO,XY) 

DUMWIL=LINET0_W(X1,Y1) 

CALL M0VET0_W(X2,Y2,XY) 

DUMWIL=LINETO_W(X3,Y3) 

CALL MOVETO_W ( XO , YO , XY ) 

DUMWIL=LINETO_W(X2,Y2) 
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CALL MOVETO_W(X1 , Y1 ,XY) 

DUMWIL=LINET0_W(X3,Y3) 

ENDIF 

24 CONTINUE 

IF(R.EQ. ’A’) THEN 
IF(ILOX.EQ.O) RETURN 
ENDIF 
READ(*,*) 

RETURN 

END 

SUBROUTINE PLSECT ( J , ITYPE , POINT , LEN , DIA , VOL ) 

C Computes plot coordinates for parallel resonator 

COMMON /PIPPXY/X , XH , XL , Y , YH , YL , XMIN , XMAX , YMIN , YMAX , SINA , COSA 
COMMON /ARCCON/XC.YC, RAD, ANG, ANGLE 
REAL LEN, POINT (8, 200) 

I NT EGER* 2 ITYPE(200) 

XOLD=X 

XHOLD=XH 

XLOLD=XL 

YOLD=Y 

YHOLD=YH 

YLOLD=YL 

ANGOLD=ANG 

ANGSAV=ANGLE 

SINOLD=SINA 

COSOL D= COSA 

DIAM=SQRT((XH-XL)**2+(YH-YL)**2) 

CALL STSECT ( J , ITYPE .POINT , DIA , DIAM ) 

XC=0. 5*(XHOLD+XH) 

XHC=XHOLD 

XLC=XL 

YC=0.5*(YH0LD+YH) 

YHC=YHOLD 

YLC=YL 

PLEN=LEN-2.0*DIA 

PDIA= ( VOL-2 . 0*DIA*DIAM)/PLEN 

CALL STSECT (J , ITYPE , POINT , PLEN , PDIA) 

CALL STSECT (J , ITYPE .POINT , DIA , DIAM) 

XSAV=X 

XHSAV=XH 

XLSAV=XL 

YSAV=Y 

YHSAV=YH 

YLSAV=YL 

SINA=COSOLD 

COSA=-SINOLD 

RADIUS=DIA 

TURN=-90.0 

SIDE=LEN-5.0*DIA 

ANG=ANG+1. 5708 

ANGLE=ANGLE+90.0 

X=XC 
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Y=YC 

XH=XHC 

XL=XLC 

YH=YHC 

YL=YLC 

CALL BNSECT ( J , ITYPE , POINT , RADIUS , TURN , DIA, DIA) 

CALL STSECT ( J , ITYPE , POINT , SIDE , DIA) 

CALL BNSECT ( J , ITYPE .POINT , RADIUS , TURN , DIA , DIA ) 

X=XSAV 

Y=YSAV 

XH=XHSAV 

XL=XLSAV 

YH=YHSAV 

YL=YLSAV 

ANG=ANGOLD 

ANGLE=ANGSAV 

SINA=SINOLD 

COSA= COSOLD 

RETURN 

END 

SUBROUTINE PNYQ(KR , KC , KW, PTS , ITYPE) 

C Plots gain and phase angle 

INCLUDE ’ FGRAPH.FD’ 

INTEGER PTS 

REAL KR(PTS) , KC(PTS) , KW(PTS) , X( 1001 ) ,YR( 1001) ,YC( 1001 ) 
R ECORD/WXY COORD/ X Y 
INTEGER*2 DUMWIL 

REAL*8 XMIN, XMAX , YMINR , YMAXR , YMINC , YMAXC , XP , YP , XLO , XHI 
DO 20 1=1, PTS 

YR(I )=SQRT(KR(I )**2+KC(I )**2) 
YC(I)=57.29578*ATAN2(KC(I) , KR ( I ) ) 

X(I)=ALOG10(KW(I) ) 

20 CONTINUE 
YMINR=YR(1) 

YMAXR=YR(1) 

YMINC=-180. 0 
YMAXC = 180.0 
XMIN=X( 1 ) 

XMAX=X( 1) 

DO 21 1=2, PTS 

IF(X(I) . LT.XMIN) XMIN=X(I) 

IF(X(I).GT.XMAX) XMAX=X(I) 

IF(YR(I).LT. YMINR) YMINR=YR(I) 

IF(YR(I).GT. YMAXR) YMAXR=YR(I) 

21 CONTINUE 
XLO=XMIN 
XHI=XMAX 

DO 22 1=1,10 
IF(XMIN.GE.I) XLO=I 
IF(XMAX.GE.I) XHI=I 

22 CONTINUE 

IF(XMAX.NE.XHI) XHI=XHI+1.0 
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IF(XLO.EQ.XHI) THEN 
XLO=XMIN 
XHI=XHAX 
ENDIF 

CALL WINDLO(XLO,XHI , YMINR, YMAXR) 
CALL LABGAIN(XLO,XHI, YMINR, YMAXR 
CALL SETLINESTYLE( 62268) 

IF(XMIN. LE.0.0. AND.XMAX.GE.O.O) 
XP=0.0 
YP= YMINR 

CALL MOVETO_W ( XP , YP , XY ) 

YP= YMAXR 

DUMWIL=LINETO_W(XP, YP) 

ENDIF 

IF(YMINR. LE.0.0. AND. YMAXR. GE. 0.0 
YP=0.0 
XP=XLO 

CALL MOVETO_W(XP, YP,XY) 

XP=XHI 

DUMWIL=LINETO_W(XP, YP) 

ENDIF 

CALL SETLINESTYLE( 65535) 

XP=X(1) 

YP=YR(1) 

CALL MOVETO_W(XP,YP,XY) 

DO 23 1=2, PTS 
XP=X(I) 

YP=YR( I ) 

DUMWIL=LINETO_W(XP, YP) 

23 CONTINUE 

CALL WINDUP (XLO,XHI ,YMINC,YMAXC) 
CALL LABANG(XLO,XHI ,YMINC,YMAXC) 
CALL SETLINESTYLE( 62268) 

IF(XMIN. LE.0.0. AND.XMAX.GE.O.O) 
XP=0.0 
YP=YMINC 

CALL MOVETO_W(XP, YP,XY) 

YP=YMAXC 

DUMWIL=LINETO_W(XP, YP) 

ENDIF 

IF(YMINC. LE.0.0. AND. YMAXC.GE. 0.0 
YP=0.0 
XP=XLO 

CALL MOVETO_W ( XP , YP , XY ) 

XP=XHI 

DUMWIL=LINETO_W(XP, YP) 

ENDIF 

CALL SETLINESTYLE( 65535) 

XP=X(1) 

YP=YC(1) 

CALL MOVETO_W(XP,YP,XY) 

DO 24 1=2, PTS 


ITYPE) 

THEN 


THEN 


THEN 


THEN 
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XP=X(I) 

YP=YC(I) 

DUMWIL=LINETO_W(XP,YP) 

24 CONTINUE 
RETURN 
ENO 

SUBROUTINE RLINE(TITL , PHRAT , SEGMN ,SECTN , PIPE1 , PIPE2 , PIPE3 , 

* PIPE4 , PIPE5 , L , AREA , DIA , PIND , PCAP , LOPEND , LOPOLD , SPLIT , IUNIT ) 

C Reads fuel or lox file 

REAL AREA(75) ,DIA(75) ,L(75) , PIND( 75 ) ,PCAP(75) 

REAL L FLOW , KT AN K , KHAN 

REAL PIPE1(75) ,PIPE2(75) , PIPE3C75) ,PIPE4(75) ,PIPE5(75) 

INTEGER SEGMN, SECTN( 75) 

COMMON /WORKIT/A , CMAN , CTANK, DENS , KMAN , KTANK , LFLOW , T FLOW , VOL , 

* VOLMF , PCHMB , DPROR 
CHARACTER* 20 TITL 

DATA GRAV/32 . 2/ , PI/32 . 2/ 

1 FORMAT (El 5. 6) 

2 FORMAT(I5,5E15.6) 

C TITLE 

READCIUNIT, ’ (A) ’ )TITL 
C TANK CONDITIONS 

READCIUNIT, l)VOL 
READCIUNIT, 1) LFLOW 
READCIUNIT, 1) KTANK 
C MANIFOLD CONDITIONS 

READCIUNIT, 1)DENS 
READCIUNIT, l)TFLOW 
READCIUNIT, DVOLMF 
READCIUNIT, 1) KMAN 
READCIUNIT, 1) PCHMB 
C ORFICE CONDITION 

READC IUNIT, 1) DPROR 
A=SQRT ( GRAV*KTANK/DENS ) 

CT ANK= DENS*VOL/KT ANK 
CMAN=DENS*VOLMF/KMAN 
PMRAT = PCHMB/TFLOW 
AVGK=0. 5*(KTANK+KMAN) 

SPLIT=1.0 
LOPOLD=20 
L0PEND=1 
C PIPING 

READCIUNIT, 2 )SEGMN 
DO 21 1=1, SEGMN 

READC IUNIT , 2 )SECTN( I ) , PIPE1 (I) , PIPE2 (I) , PIPE3C I ) , PIPE4C I ) , 

* PIPE5CI) 

IF(SECTNCI).EQ.O) THEN 

CALL BENDS(PIPE1(I),PIPE2(I),PIPE3(I),PIPE4( I), VALUE, DIME) 

AREAB=0. 785398*DIME**2 

L(I)=VALUE 

AREA(I)=AREAB 

DIA(I)=DIME 
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ELSEIF(SECTN( I ) . EQ. 1 . OR. SECTN( I ) . EQ. 9 ) THEN 
C STRAIGHT SECTION OR SPLIT 

VALUE=PIPE1(I) 

DIME=PIPE2(I) 

AREAB=0. 785398*DIME**2 
L(I)=VALUE 
AREA(I)=AREAB 
DIA(I)=DIME 

I F( SECTN ( I ) . EQ . 9 ) THEN 
SPLIT=PIPE3(I) 

WRITE(*, ’ (A, 13) ’ ) ’ Max. no. of Iterations is set at ’.LOPOLD 
WRITE(», ’ (A\) ’ ) ’ Do you wish to change It? ’ 

READ(*,’(A)’)ANS 

I F ( ANS . EQ . ’ Y ’ . OR . ANS . EQ . ’ y ’ ) THEN 
WRITE(*, ’ (A\) ’ ) ’ Enter maximum no. of iterations ’ 
READ(*,*)LOPOLD 
ENDIF 

LOPEND=LOPOLD 
ENDIF 

ELSEIF(SECTN(I) . EQ. 2) THEN 
INLINE ACCUMULATOR 
PIPE1 - LEN - L 

PIPE2 - DIA - DIA 

PIPE3 - DEN 

PIPE4 - K 

L(I)=PIPE1(I) 

DIA(I)=PIPE2(I) 

AREA(I)=0.25*PI*PIPE2(I)**2 
IF(PIPE3(I) . EQ.0.0) PIPE3(I)=DENS 
IF(PIPE4(I) . EQ.O. 0) PIPE4(I)=AVGK 
PCAP(I)=PIPE3(I)*L(I)*AREA(I)*PMRAT/PIPE4(I) 

ELSEIF(SECTN(I) . EQ. 3) THEN 

TUNED STUB ACCUMULATOR 

SUPPRESSES OMEGA = (PI/2)/(L*SQRT(PIND*PCAP) ) 

PIPE1 - LEN - L 

PIPE2 - DIA - DIA 

PIPE3 - DEN 

PIPE4 - K 

L(I)=PIPE1(I) 

DIA(I)=PIPE2(I) 

AREAd)=0.25*PI*DIAd)**2 
IF(PIPE3(I) . EQ.0.0) PIPE3(I)=DENS 
IF(PIPE4(I). EQ.0.0) PIPE4(I)=AVGK 
PCAP(I )=PIPE3(I )*L(I )*AREA(I )*PMRAT/PIPE4(I ) 

PIND( I )=L ( I )/(AREA( I ) *GRAV*PMRAT ) 

ELSEIF(SECTN(I ) . EQ. 4.0R.SECTN(I ) . EQ. 5) THEN 
HELMHOLTZ RESONATOR ACCUMULATOR 
PARALLEL RESONATOR ACCUMULATOR 

SUPPRESSES OMEGA = 1/SQRT(PIND*PCAP) 

PIPE1 - LEN - L 

PIPE2 - DIA - DIA 

PIPE3 - VOL - AREA 
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C PIPE4 - DEN 

C PIPE5 - K 

L(I)=PIPE1(I) 

DIA(I)=PIPE2(I) 

AREA(I)=PIPE3(I) 

IF(PIPE4(I) . EQ. 0. 0) PIPE4(I)=DENS 
IF(PIPE5(I) . EQ.0.0) PIPE5(I)=AVGK 
PCAP( I )=PIPE4( I )*AREA( I )*PMRAT/PIPE5( I ) 
PIND(I)=L(I)/(0.25*PI*DIA(I)**2*GRAV*PMRAT) 

ELSEIF(SECTN(I ) . EQ. 6) THEN 
PUMP 

PIPE1 - LEN - L 

PIPE2 - DIA - DIA 

PIPE3 - DP/DM - AREA 

PIPE4 - IND - PIND 

PIPE5 - CAP - PCAP 

L(I)=PIPE1(I) 

DIA(I)=PIPE2(I) 

AREA(I)=PIPE3(I) 

PCAP(I)=PIPE4(I)*PMRAT 
PIND(I)=PIPE5(I)/PMRAT 
ENDIF 

21 CONTINUE 
RETURN 
END 

SUBROUTINE SETPLT 
C Sets up the plot environment 

INCLUDE ’FGRAPH.FD’ 

RECORD /videoconf 1 g/ screen 
COMMON screen 

COMMON /WCAPAS/IFRST 
LOGICAL fourcolors 
EXTERNAL fourcolors 
COMMON /NOCOL/NCOLS , NMODE 
INTEGER*2 NCOLS, NMODE 
IFRST=0 

IF( .NOT.fourcolorsO ) THEN 

WRITE (*,*) ’ This program requires a CGA, EGA, or’, 

+ ’ VGA graphics card.’ 

STOP 
END IF 

NCOLS = screen. numtextco Is 

NMODE = screen. mode 

RETURN 
END 

SUBROUTINE STSECT( J , ITYPE, POINT , LEN, DIA) 

C Computes plot coordinates for a straight section 

COMMON /PIPPXY/X , XH , XL , Y , YH , YL , XMIN , XMAX , YMIN , YMAX , SINA , COSA 
REAL LEN, POINT (8, 200) 

INTEGER*2 ITYPE(200) 

J=J+1 

ITYPE(J)=1 
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XH=X-0.5*SINA*DIA 

XL=X+0.5*SINA*DIA 

YH=Y+0.5*C0SA*DIA 

YL=Y-0.5*COSA*DIA 

POINT (1,J)=XH 

POINT(2 , J )=YH 

POINT(3,J)=XL 

POINT(4,J)=YL 

X=X+COSA*LEN 

XH=X-0.5*SINA*DIA 

XL=X+0.5*SINA*DIA 

Y=Y+SINA*LEN 

YH=Y+0 . 5*COSA*DIA 

YL=Y-0.5*C0SA*DIA 

POINT(5 , J)=XH 

POINT(6, J)=YH 

POINT(7,J)=XL 

POINT(8, J)=YL 

XMIN=AMIN1(X,XL,XH,XMIN) 

XMAX=AMAX1 (X , XL , XH , XMAX ) 

YMIN=AMIN1(Y, YL,YH, YMIN) 

YHAX= AMAX1 ( Y , YL , YH , YMAX ) 

RETURN 

END 

SUBROUTINE TSSECT (J , ITYPE , POINT , LEN , DIA) 

C Computes plot coordinates for a tuned stub 

COMMON /PIPPXY/X , XH , XL , Y , YH , YL , XMIN , XMAX , YMIN , YMAX , SINA , COSA 
REAL LEN, POINT (8, 200) 

INTEGER*2 ITYPE(200) 

J=J+1 

ITYPE( J)=l 

DIAM=SQRT ( ( XH-XL ) **2+ ( YH-YL ) **2 ) 

XH=X-SINA*(LEN+0.5*DIAM) 

YH=Y+C0SA*(LEN+0. 5*DIAM) 

POINT (1,J)=XH 

POINT(2 , J )=YH 

POINT(3,J)=XL 

POINT (4, J)=YL 

X=X+COSA*DIA 

XH=X-SINA*(LEN+0.5*DIAM) 

XL=XL+COSA*DIA 

Y=Y+SINA*DIA 

YH=Y+C0SA*(LEN+0.5*DIAM) 

YL=YL+SINA*DIA 
POINT(5, J)=XH 
POINT(6, J)=YH 
POINT(7,J)=XL 
POINT(8, J)=YL 
XMIN=AMIN1(X,XL,XH,XMIN) 

XMAX=AMAX1 (X , XL , XH , XMAX ) 

YMIN=AMIN1(Y, YL ,YH,YMIN) 

YMAX= AMAX1 ( Y , YL , YH , YMAX ) 
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RETURN 

END 

SUBROUT I NE UPPERW ( XOO , YOO , XI 1 , Y1 1 , I LOX , R ) 

C Sets up upper plotting window 

INCLUDE ’ FGRAPH. FD’ 

RECORD/RCCOORD/S 
INTEGERS dummy 

INTEGER*2 xwidth, yheight, cols, rows 

RECORD /videoconf ig/ screen 

COMMON screen 

COMMON /NOCOL/NCOLS , NMODE 

INTEGER*2 NCOLS, NMODE 

CHARACTER*2 AP 

CHARACTER*40 TITLE 

CHARACTER*20 TITLF 

COMMON /WCAT IT/TITLE , TITLF , IHR, IMIN, AP, IYR, IMON , I DAY 
REAL*8 XO, XI, YO, Y1 
CHARACTER* 1 R 

xwidth = screen. numxpixe Is 

yheight = screen. numypixels 

cols = screen. numtextcols 

rows = screen. numtext rows 

halfy = yheight/2 

X0=X00 

Y0=Y00 

X1=X11 

Y1=Y11 

PICX=XWIDTH-20 

PICY=HALFY-30 

IF(NCOLS. LE. 40) PICY=HALFY-20 
XRANG=DABS(X1-X0) 

YRANG= DABS ( Y 1- YO ) 

XRAT=PICX/XRANG 
YRAT=PICY/YRANG 
IF(XRAT.LT.YRAT) THEN 
YRAT = P I C Y/XRAT 
ADDY=0. 5* ( YRAT-YRANG ) 

Y0=Y0-ADDY 
Y1=Y1+ADDY 
ELSE 

XRAT=PICX/YRAT 
AD0X=0. 5*(XRAT-XRANG) 

XO=XO-ADDX 
X1=X1+ADDX 
ENDIF 

window 

I F ( R .EQ. ’A’) THEN 
IF(NMODE.EQ.6) THEN 

CALL setviewport( 10, halfy + 10, xwidth - 10, yheight - 10 ) 
dummy = setw1ndow( .TRUE., X0-1.0, Y0-1.0, Xl+1.0, Yl+1.0 ) 
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CALL settextw1ndow( (rows / 2 ) + 1, 1, rows, cols) 

ELSE 

CALL setviewport( 10, halfy + 10, xwidth - 10, yheight - 10 ) 
dummy = setw1ndow( .TRUE., X0-1.0, Y0-1.0, Xl+1.0, Yl+1.0 ) 
CALL settextw1ndow( (rows / 2 ) + 1, 5, rows, cols - 5) 

ENDIF 

CALL clearscreen( IGWINDOW ) 

IF(ILOX.EQ.O) dummy = rectangle_w( $GB0RDER, XO, YO, XI, Y1 ) 
IF(NMODE.EQ.6) THEN 
CALL SETTEXTPOSITION(1,15,S) 

ELSE 

CALL SETTEXTPOSITION(l , 30, S) 

ENDIF 

CALL 0UTTEXT( ’FUEL PIPE LAYOUT’) 

ENDIF 

IF(R.EQ. ’B’.OR.ILOX.EQ.l) THEN 
IF(NMODE.EQ.6) THEN 

CALL setviewport( 10, 20, xwidth - 10, halfy ) 

dummy = setw1ndow( .TRUE., X0-1.0, Y0-1.0, Xl+1.0, Yl+1.0 ) 

CALL settextw1ndow(0 , 1, (rows / 2 ) , cols) 

ELSE 

CALL setviewport( 10, 25, xwidth - 10, halfy - 5 ) 

dummy = setw1fldow( .TRUE., X0-1.0, Y0-1.0, Xl+1.0, Yl+1.0 ) 

CALL settextwindow(0 , 1, (rows / 2 ) , cols - 5) 

ENDIF 

CALL clearscreen( IGWINDOW ) 

dummy = rectangle_w( IGBORDER , XO, YO, XI, Y1 ) 

IF(NMODE. EQ. 6) THEN 
CALL SETTEXTPOSITION(0,1,S) 

ELSE 

CALL SETTEXTPOSITION(0, 20,S) 

ENDIF 

CALL OUTTEXT(TITLE) 

IF(NMODE.EQ.6) THEN 
CALL SETTEXTPOSITION(2 , 15, S) 

ELSE 

CALL SETTEXTPOSITION(2 , 30, S) 

ENDIF 

IF(ILOX.EQ.O) CALL OUTTEXT(’LOX PIPE LAYOUT’) 

ENDIF 

RETURN 

END 

SUBROUTINE WINDLO( XMIN , XMAX , YMIN , YMAX ) 

C Sets up gain window 

INCLUDE ’FGRAPH.FD’ 

INTEGER*2 dummy 

INTEGER*2 xwidth, yheight, cols, rows, halfy 

RECORD /vldeoconf 1g/ screen 

COMMON screen 

COMMON /NOCOL/NCOLS , NMODE 

INTEGER*2 NCOLS 

REAL*8 XMIN, XMAX, YMIN, YMAX, XLEN, YLEN 
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REAL*8 XMINP, XMAXP, YMINP, YMAXP 
XLEN=0.1*(XMAX-XMIN) 

YLEN=0. 1*(YMAX-YMIN) 

XMINP=XMIN-XLEN 

XMAXP=XMAX+XLEN 

YMINP=YMIN-YLEN 

YMAXP=YMAX+YLEN 

xwidth = screen. numxpixe Is 

yhelght = screen. numyplxe Is 

cols = screen. numtextco Is 

rows = screen. numtext rows 

halfy = yheight/2 

window 

IFCNCOLS.LE.40) THEN 

CALL setvIewportC 50, halfy + 10, xwidth - 20, yheight - 30 ) 
ELSE 

CALL setviewportC 100, halfy + 10, xwidth - 50, yhelght - 50 ) 
ENDIF 

CALL settextw1ndow( (rows / 2 ) + 1, 1, rows, cols - 1) 
dummy = setwIndowC. TRUE. , XMINP, YMINP, XMAXP, YMAXP) 

CALL clearscreenC $GWINDOW ) 

RETURN 

END 

SUBROUTINE WINDUPCXMIN , XMAX , YMIN , YMAX) 

Sets up phase angle window 
INCLUDE ’FGRAPH.FD’ 

INTEGER*2 dummy 

INTEGER*2 xwidth, yhelght, cols, rows, halfy 

RECORD /vldeoconf 1 g/ screen 

COMMON screen 

COMMON /NOCOL/NCOLS , NMODE 

INTEGER*2 NCOLS 

REAL*8 XMIN , XMAX, YMIN, YMAX, XLEN, YLEN 
REAL*8 XMINP, XMAXP, YMINP, YMAXP 
XLEN=0.1*(XMAX-XMIN) 

YLEN=0. 1*( YMAX- YMIN) 

XMINP=XMIN-XLEN 

XMAXP=XMAX+XLEN 

YMINP=YMIN-YLEN 

YMAXP=YMAX+YLEN 

xwidth = screen. numxpixels 

yhelght = screen. numyplxe Is 

cols = screen. numtextcols 

rows = screen. numtext rows 

halfy = yheight/2 

window 

IF(NCOLS. LE.40) THEN 

CALL setviewportC 50, 10, xwidth - 20, halfy - 30 ) 
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ELSE 

CALL setviewport( 100, 10, xwidth - 50, halfy - 50 ) 

ENDIF 

CALL settextw1ndow( 1, 1, (rows / 2 ) - 1, cols - 1) 
dummy = setw1ndow( .TRUE. ,XMINP,YMINP,XMAXP,YMAXP) 

CALL clearscreen( $GWINDOW ) 

RETURN 

END 

SUBROUTINE WORKFR ( A , CMAN , CTANK , DENS , KMAN , KTANK , LFLOW , TFLOW , VOL , 

* VOLMF , PCHMB , DPROR ) 

C Moves arguments from common /WORKIT/ 

COMMON /WORKIT/WORK(12) 

REAL KMAN, KTANK, LFLOW 
A=WORK(l) 

CMAN=WORK(2) 

CTANK=WORK(3) 

DENS=WORK(4) 

KMAN=WORK(5) 

KTANK=WORK(6) 

LFLOW=WORK(7) 

TFLOW=WORK(8) 

VOL=WORK(9) 

VOLMF=WORK( 10 ) 

PCHMB=WORK(ll) 

DPROR=WORK(12) 

RETURN 

END 

SUBROUTINE WORKTO ( A , CMAN , CTANK , DENS , KMAN , KTANK , LFLOW , TFLOW , VOL , 

* VOLMF, PCHMB, DPROR) 

C Moves arguments to common /WORKIT/ 

COMMON /WORKIT/WORK(12) 

REAL KMAN, KTANK, LFLOW 

WORK(l)=A 

WORK(2)=CMAN 

WORK(3)=CTANK 

W0RK(4)=DENS 

WORK(5)=KMAN 

WORK(6)=KTANK 

WORK(7)=LFLOW 

W0RK(8)=TFL0W 

WORK(9)=VOL 

WORK (10)= VOLMF 

WORK(ll)=PCHMB 

WORK( 12)= DPROR 

RETURN 

END 

SUBROUTINE ZREAD(NAME, VALUE) 

C Reads Input for Input modification 

CHARACTER* 1 NAME(8) 

CHARACT ER* 1 CARD ( 80 ) , PLUS , MINUS , PERIOD , LE , E , NUMBER ( 10 ) 
CHARACTER* 1 LEND(3) ,CEND(3) .POUND, QUEST, BLK, COMMA 
CHARACTER*! LTIT(5) ,CTIT(5) 


C - 65 



CHARACTER*80 DCARD 
EQUIVALENCE (CARD(l) , DCARD) 

DATA PLUS/’+’/, MINUS/’-’/, PERIOD/’. 7, LE/’e’/.E/’E’/.BLK/’ ’/ 
DATA NUMBER/’0’,’lV2V3\’4’,’5\’6V7V8\’97,C0MMA/’,7 
DATA LEND/’e’ , ’n’ , ’d’/,CEND/’E’ , ’N’ , ’D’/, POUND/’# 7, QUEST/’?’/ 
DATA LTIT/’tVr, ’tVl Ve7,CTIT/’T’ f ’IVTVLVE’/ 

1 FORMAT (A) 


DO 21 1=1,8 
NAME(I)=BLK 

21 CONTINUE 
READ(*,1) DCARD 
IF(CARD(1).EQ. POUND) THEN 

NAME(l)=POUND 

RETURN 

ENDIF 

I F ( CARD( 1 ) . EQ . QUEST ) THEN 
NAME(1)=QUEST 
RETURN 
ENDIF 

DO 22 1=1,3 

IF(CARD(I).NE.LEND(I).AND.CARD(I).NE.CEND(I)) GO TO 220 
NAME(I)=CEND(I) 

22 CONTINUE 
RETURN 

220 CONTINUE 

DO 221 1=1,5 

IF(CARD(I) .NE. LTIT ( I ) . AND.CARD(I) .NE.CTIT(I) ) GO TO 23 
NAME(I)=CTIT(I) 

221 CONTINUE 
RETURN 

23 CONTINUE 


DO 24 1=1,8 
II=I 

IF(CARD(I) . EQ. BLK.OR. CARD( I ) . EQ. COMMA) GO TO 25 
NAME(I)=CARD(I) 

24 CONTINUE 

25 CONTINUE 

DO 26 1=11,80 
ID=I 

IF(CARD(I).NE.BLK. AND. CARD(I).NE. COMMA) GO TO 27 

26 CONTINUE 


VALUE=0.0 

WRITE (*,*)’ No value given, ZERO assumed’ 

RETURN 
27 CONTINUE 


SIGNsl.O 

IF(CARD(ID).EQ. MINUS) THEN 
SIGN=-1 . 0 


ID=ID+1 

ELSEI F ( CARD ( I D ) . EQ . PLUS ) THEN 
ID=ID+1 
ENDIF 
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WHOLE=0.0 
DO 30 I=ID,80 
II=I 

IF(CARD(I).EQ. PERIOD) GO TO 31 
IF(CARD(I) . EQ.PLUS) GO TO 36 
IF(CARD(I).EQ. MINUS) GO TO 36 
IF(CARD(I) . EQ. E.OR.CARD(I ) . EQ. LE) GO TO 35 
DO 28 J=1 , 10 
JJ=J-1 

IF(CARD(I) . EQ.NUMBER(J)) GO TO 29 

28 CONTINUE 

VALUE=SIGN*WHOLE 

IF(CARD(I).EQ.BLK) RETURN 

WRITE(*,*)’ Input error, value set to ZERO’ 

VALUE=0.0 

RETURN 

29 CONTINUE 

WHOLE=WHOLE*10 . 0+J J 

30 CONTINUE 
VALUE=SIGN*WHOLE 
RETURN 

31 CONTINUE 
ID=II+1 
FRACT=0.0 
ICOUNT=0 

DO 34 I=ID,80 
I COUNT =IC0UNT+1 
II=I 

IF(CARD(I).EQ. PERIOD) THEN 
WRITE(*,*)’ Input error, value set to ZERO’ 
VALUE=0.0 
RETURN 
ENDIF 

IF(CARD(I). EQ.PLUS) GO TO 36 
IF(CARD(I).EQ. MINUS) GO TO 36 
IF(CARD(I) . EQ.E.OR.CARD(I).EQ.LE) GO TO 35 
DO 32 J=l,10 
JJ=J-1 

I F ( CARD ( I ) . EQ . NUMBER ( J ) ) GO TO 33 

32 CONTINUE 

VALUE=SIGN* ( WHOLE+FRACT ) 

IF(CARD(I) . EQ.BLK) RETURN 

WRITE(*,*)’ Input error, value set to ZERO’ 

VALUE=0. 0 

RETURN 

33 CONTINUE 

FRACT= FRACT+ J J/ 1 0 . 0** I COUNT 

34 CONTINUE 

VALUE=SIGN* (WHOLE+FRACT) 

RETURN 

35 CONTINUE 
11=11+1 
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36 CONTINUE 

VALUE=SIGN*(WHOLE+FRACT) 

SIGN=1.0 

IF(CARD(II).EQ. MINUS) THEN 
SIGN=-1 . 0 
11 = 11+1 

ELSEIF(CARD(II). EQ.PLUS) THEN 
11 = 11+1 
ENDIF 
WHOLE=0. 0 
DO 39 1=11,80 
DO 37 J=l,10 
JJ=J-1 

IF(CARD(I ) . EQ.NUMBER( J) ) GO TO 38 

37 CONTINUE 

VALUE=VALUE*10 . 0** ( SIGN*WHOLE ) 

IF(CARD(I) . EQ.BLK) RETURN 

WRITE(*,*)’ Input error, value set to ZERO’ 

VALUE=0.0 

RETURN 

38 CONTINUE 

WHOLE=WHOLE*10.0+JJ 

39 CONTINUE 

VALUE=VALUE*10. 0**(SIGN*WHOLE) 

RETURN 

END 
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Appendix D 

Listing of Intermediate Frequency Program 
S R R EEQ 
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PROGRAM SFREQ 


C 
C 
C 

C Intermediate Mode Oscillations 

C 

C Modified for n vs tau plots 

C 

C 

C Variables In Commons 

C 

C /CMPVAL/ 


c 

CVARC17) 

COMPLEX*8 

equ1valence(CVAR(l) ,X1) 

c 

XI 

COMPLEX*8 

first order term of x 

c 

Y1 

COMPLEX*8 

first order term of y 

c 

11 

COMPLEX* 8 

first order term of z 

c 

W1 

COMPLEX*8 

first order term of w 

c 

Ml 

COMPLEX*8 

first order term of m 

c 

PO 

COMPLEX*8 

zeroth order term of pressure 

c 

PI 

COMPLEX*8 

first order term of pressure 

c 

uo 

COMPLEX*8 

zeroth order term of velocity 

c 

U1 

C0MPLEX*8 

first order term of velocity 

c 

RFH 

COMPLEX*8 

combustion response function for mixture ratio 

c 

RFK 

COMPLEX*8 

compustlon response function for mass flow 

c 

RFP 

COMPLEX*8 

combustion response function for pressure 

c 

S 

COMPLEX*8 

lamda + mu I - perturbation oscillation 

c 

GF 

COMPLEX*8 

admittance of fuel line looking toward tank 

c 

GOX 

COMPLEX* 8 

admittance of lox line looking toward tank 

c 

RFA 

C0MPLEX*8 

nozzle pressure admittance coefficient 

c 

p 

RFC 

COMPLEX*8 

nozzle entropy admittance coefficient 

c 


/DIMVAL/ 

c 

AJUNK1(8) 

REAL*4 

equlvalence(AJUNKKl) ,ND) 

c 

HOLDD(20) 

REAL*4 

equ1valence(H0LDD(l) ,ND) 

c 

NO 

REAL*4 

pressure Interaction Index 

c 

TAUD 

REAL*4 

sensitive time lag (sec) 

c 

DTAUD 

REAL*4 

delta time lag (sec) 

c 

NRO 

REAL*4 

enthalpy Interaction Index 

c 

LAMDAD 

REAL*4 

damping of perturbation 

c 

MUD 

REAL*4 

frequency of perturbation (rad/sec) 

c 

CDIAM 

REAL*4 

chamber diameter (ft) 

c 

TDIAM 

REAL*4 

throat diameter (ft) 

c 

XLCD 

REAL*4 

x location of chamber-nozzle Interface (ft) 

c 

AJUNK2(161) 

REAL*4 

equ 1 va 1 ence ( AJUNK2 (1 ) , GAMMAD ) 

c 

GAMMAD 

REAL*4 

ratio of specific heats 

c 

RGAS 

REAL*4 

gas constant (ft~2/sec~2/*R) 

c 

POOD 

REAL*4 

maximum pressure at Injection face (lbf/ft A 2) 

c 

MBARD 

REAL*4 

mean combustion response function (Ibm/sec) 

c 

RBARD 

REAL*4 

mean mixture ratio 

c 

DCSDRD 

REAL*4 

d(cstar)/d(m1xture ratio) (ft/sec) 

c 

DHLDRD 

REAL*4 

d(enthalpy/d(m1xture ratio) (ft~2/sec~2) 

c 

RHOLOD 

REAL*4 

mass of liquid per unit chamber vol (lbm/ft"3) 

c 

ULOD 

REAL*4 

axial component of liquid velocity (ft/sec) 
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c 

PCHMB 

REAL*4 

chamber pressure (lbf/ft~2) 

c 

TCHMB 

REAL*4 

chamber temperature (’R) 

c 

XBARDC50) 

REAL*4 

x locations along axis (ft) 

c 

PBAR(50) 

REAL*4 

pressure along axis (1bf/ft A 2) 

c 

p 

TBAR(50) 

REAL*4 

temperature along axis (*R) 

V 

c 


/FFACT/ 

c 

p 

FFAC 

REAL*4 

factor for frequency 

c 


/ NVAL/ 

c 

r 

NVAL 

I NT EGER* 2 

number of Input points along axis 

c 


/PIPES/ 

c 

PFACE 

REAL*4 

pressure at injector face (lbf/ft 2) 

c 

TFACE 

REAL*4 

mean combustion response function (ibm/sec) 

c 

ASTAR 

REAL*4 

speed of sound at injector face (ft/sec) 

c 


/RELVAL/ 

c 

RVAR(13) 

REAL*4 

equ1valence(RVAR(l) ,N) 

c 

N 

REAL*4 

pressure Interaction Index 

c 

TAU 

REAL*4 

sensitive time lag 

c 

DTAU 

REAL*4 

delta time lag 

c 

NR 

REAL *4 

enthalpy Interaction Index 

c 

RBAR 

REAL*4 

mean mixture ratio 

c 

MBAR 

REAL*4 

mean combustion response function 

c 

GAMMA 

REAL*4 

ratio of specific heats 

c 

POO 

REAL*4 

maximum pressure at Injection face 

c 

DHLDR 

REAL*4 

d(enthalpy)/d(mixture ratio) 

c 

CSTAR 

REAL*4 

characteristic velocity at combustor exit 

c 

DCSDR 

REAL*4 

d(cstar)/d(m1xture ratio) 

c 

RHOLO 

REAL*4 

mass of liquid per unit chamber volume 

c 

ULO 

REAL*4 

axial component of liquid velocity 

c 

LAMDA 

REAL*4 

damping of perturbation 

c 

MU 

REAL*4 

frequency of perturbation 

c 

TAUT 

REAL*4 

total time lag 

c 

UBAR(50) 

REAL*4 

velocity along axis 

c 

XBAR(50) 

REAL*4 

x locations along axis 

c 

p 

XLC 

REAL*4 

x location of chamber-nozzle Interface 

c 


/RESULT/ 

c 

PP 

COMPLEX*8 

P’ = PO + PI 

c 

UP 

COMPLEX*8 

U’ = UO + U1 

c 

SIGP 

COMPLEX* 8 

SIG’ = SIGO + SIG1 

c 

p 

FUNB 

COMPLEX*8 

boundary function U’ + RFA * P’ + RFC * SIG 

c 


/mu 

c 

TITLE 

CHAR*60 

title for plots Including date andd time 

c 

TITLF 

CHAR*40 

Input title 

c 

IHR 

INTEGER*2 

hour code run 

c 

IMIN 

INTEGER*2 

minute code run 

c 

AP 

CHAR* 2 

AM or PM 

c 

IYR 

INTEGER*2 

yesr code run 
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as 



c 

c 

c 

c 

c 

c 

c 

c 

c 


IMON 
I DAY 


INTEGERS 

INTEGER*2 


month code run 
day code run 


PROGRAM SFREQ 

Logic portion of code 


Commons CMPVAL 


DIMVAL FFACT 
Local Variables 


INTVAL RELVAL RESULT TITL 


c 

AM 

CHAR*2 

’AM’ 

c 

ANS 

CHAR*1 

response to question 

c 

DELF 

REALM 

Intermediate variable 

c 

DELVAL 

REALM 

Intermediate variable 

c 

FREQ (50) 

REALM 

array of frequencies 

c 

I 

INTEGER*2 

do loop Index 

c 

ID 

INTEGER*2 

flag for dependent variable 

c 

II 

INTEGER*2 

flag for Independent variable 

c 

ISEC 

INTEGER*2 

seconds at start 

c 

1100 

INTEGER*2 

hundreds of seconds at start 

c 

J 

INTEGER*2 

do loop Index 

c 

NOF 

INTEGER*2 

maximum number of frequencies 

c 

NOT 

INTEGER*2 

maximum number of tau’s 

c 

NPTF 

INTEGER*2 

number of frequencies 

c 

NPTS 

INTEGER*2 

number of tau’s 

c 

PM 

CHAR*2 

’PM’ 

c 

RADHER(2) 

CHAR*8 

labels 

c 

ROCIN 

CHAR424 

input file name 

c 

ROCOUT 

CHAR* 2 4 

output file name 

c 

ROCVAR 

CHAR*24 

file name for frequencies or tau’s 

c 

START F 

REAL*4 

starting frequency 

c 

STARTV 

REAL*4 

starting tau 

c 

STOPF 

REAL*4 

ending frequency 

c 

STOPV 

REAL*4 

ending tau 

c 

TAULST (200) 

REAL*4 

array of tau’s 

c 

TOL 

REAL*4 

convergence criteria 

c 

YP(200,50) 

REAL*4 

array of n’s 

c 

VARP(3) 

CHAR*8 

labels 

c 

c 

VAR1 

REALM 

Intermediate variable 

c 

c 

SUBROUTINE ADMIT(S,GADM,A,, 

AR EA , CMAN , CTANK , DPROR , L , L F LOW , PCHMB , : 

c 

determines 

admittance 

looking toward tank 

c 

Commons DIMVAL 

PIPES 


c 


Variables 

In Argument List 

c 

A 

REALM 

speed of sound In the fluid 

c 

AREA(75) 

REALM 

area of pipe section 

c 

CMAN 

REALM 

manifold capacitance 

c 

CTANK 

REALM 

tank capacitance 

c 

DPROR 

REALM 

pressure drop across orflces 

c 

GADM 

COMPLEX*8 

admittance of line looking toward 

c 

L ( 75 ) 

REALM 

length of pipe section 
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c 

LFLOW 

REALM 

flow rate through pipe 

c 

PCHMB 

REALM 

chamber pressure 

c 

S 

COMPLEX*8 

complex frequency 

c 

SEGMN 

INTEGER*2 

number of pipe sections 

c 

TFLOW 

REALM 

total flow rate of engine 

c 


Local Variables 

c 

G ( 76 ) 

COMPLEX*8 

admittance looking toward 

c 

GRAV 

REALM 

gravitational constant (11 

c 

I 

I NT EGER* 2 

do loop Index 

c 

TL 

REALM 

Intermediate variable 

c 

W 

COMPLEX*8 

normalized frequency 

c 

ZLINE 

REALM 

Intermediate variable 

c 

ZOR 

REALM 

Intermediate variable 

c 

ZTOP 

REALM 

Intermediate variable 


c 

c 

c 

c 

c 


SUBROUTINE BENDS ( PI PEI , PI PE2 , PIPE3 , PIPE4 , VALUE , DIME ) 
Computes effective straight pipe for bend 


c 


Variables 

In Argument List 

c 

DIME 

REALM 

effective diameter (ft) 

c 

PIPE1 

REALM 

radius of bend (ft) 

c 

PIPE2 

REALM 

angle of bend (degrees) 

c 

PIPE3 

REALM 

diameter of bend (ft) 

c 

PIPE4 

REALM 

length of end straight 

c 

VALUE 

REALM 

effective length (ft) 

c 


Local Variables 

c 

ARBND 

REALM 

area of bend 

c 

AREAB 

REALM 

effective area of bend 

c 

BENDR 

REALM 

bend angle In radians 

c 

GAMMA 

REAL *4 

Intermediate variable 

c 

INERT 

REALM 

Intermediate variable 

c 

INRAD 

REALM 

Inside radius of bend 

c 

LBEND 

REALM 

Intermediate variable 

c 

LPRME 

REALM 

Intermediate variable 

c 

NEWLN 

REALM 

Intermediate variable 

c 

OTRAD 

REALM 

outside radius of bend 

c 

RATIO 

REALM 

Intermediate variable 

c 

X 

REALM 

Intermediate variable 

c 

c 

Y 

REALM 

Intermediate variable 

c 

c 

SUBROUTINE BOUND (PP, UP, SIGP,FUNB) 

c 

Evaluates 

the boundary function 

V/ 

c 

Commons CMPVAL 

INTVAL RELVAL 

c 


Variables 

In Argument List 

c 

FUNB 

C0MPLEX*8 

boundary function U’ + 

c 

PP 

COMPLEX* 8 

P’ = PO + PI 

c 

SIGP 

C0MPLEX*8 

SIG’ = SIGO + SIG1 

c 

UP 

C0MPLEX*8 

U’ = UO + U1 


(ft) 


RFA * P* + RFC * SIG’ 
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c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


COMPLEX FUNCTION CCOSH(S) 

Evaluates the complex hyperbolic cosine 


S 

COSHI 

COSHR 

LAMDA 

MU 


Variables In Argument List 
COMPLEX*8 complex frequency 
Local Variables 

REALM Intermediate variable 

REALM Intermediate variable 

REALM real part of complex frequency 

REALM imaginary part of complex frequency 


COMPLEX FUNCTION CSINH(S) 

Evaluates the complex hyperbolic sine 


S 

LAMDA 

MU 

SINHI 

SINHR 


Variables In Argument List 
COMPLEX*8 complex frequency 
Local Variables 

REALM real part of complex frequency 

REALM imaginary part of complex frequency 

REALM Intermediate variable 

REALM Intermediate variable 


COMPLEX FUNCTION CTANH(S) 

Evaluates the complex hyperbolic tangent 

Variables in Argument List 
S C0MPLEX*8 complex frequency 

Local Variables 

CTAND COMPLEX* 8 hyperbolic sine 

CTANN C0MPLEX*8 hyperbolic cosine 


SUBROUTINE EVAL(X) 

Evaluates parameters at a given x location 

Commons CMPVAL INTVAL RELVAL 

Variables In Argument List 
X REALM axial location 

Local Variables 

I I NT EGER* 2 do loop Index 

FAC REALM Intermediate variable 

UB REALM Intermediate variable 


COMPLEX FUNCTION FPl(XL) 

Evaluates PI 

Commons CMPVAL INTVAL RELVAL 

Variables In Argument List 
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c 

XL 

REALM 

length of chamber 

c 


Local Variables 

c 

DX 

REALM 

Integration Increment 

c 

I 

INTEGER*2 

do loop variable 

c 

VINT 

COMPLEX*8 

Intermediate variable 

c 

c 

X 

REALM 

current x location 

c 

c 

COMPLEX FUNCTION FSIGP(XL) 


c 

Evallates SIG’ 


Vs 

c 

Commons CMPVAL 

INTVAL RELVAL 

c 


Variables 

In Argument List 

c 

XL 

REALM 

length of chamber 

c 


Local Variables 

c 

DX 

REALM 

integration Increment 

c 

FAC 

REALM 

Intermediate variable 

c 

FCON 

COMPLEX*8 

Intermediate variable 

c 

FSIG2 

COMPLEX*8 

Intermediate variable 

c 

I 

INTEGER*2 

do loop Index 

c 

II 

INTEGER*2 

do loop Index 

c 

J 

INTEGER*2 

do loop Index 

c 

UB(51) 

REALM 

Intermediate variable array 

c 

VINT(51) 

COMPLEX*8 

Intermediate variable array 

c 

WINT(51) 

COMPLEX*8 

Intermediate variable array 

c 

c 

X 

REALM 

current x location 

c 

c 

SUBROUTINE FUEL(S.GF) 


c 

r 

Handles fuel 

1 piping logic 

Vs 

c 

Common PIPES 



c 


Variables 

In Argument List 

c 

GF 

COMPLEX*8 

admittance of fuel line looking toward tank 

c 

S 

COMPLEX*8 

complex frequency 

c 


Local Variables 

c 

A 

REALM 

speed of sound In the fluid (ft/sec) 

c 

ANS 

CHARM 

response to question 

c 

AREA(75) 

REALM 

area of pipe section (ft" 2) 

c 

AREAB 

REALM 

intermediate variable 

c 

CMAN 

REALM 

manifold capacitance 

c 

CTANK 

REALM 

tank capacitance 

c 

DENS 

REALM 

density of fluid 

c 

DIA(75) 

REALM 

diameter of pipe section 

c 

DIME 

REALM 

Intermediate variable 

c 

DPROR 

REALM 

pressure drop across orflces (lbf/ft"2) 

c 

FLOWL 

REALM 

intermediate variable 

c 

FUELIN 

CHAR* 2 4 

name of file containing fuel piping data 

c 

GRAV 

REALM 

gravitational constant (lbm-ft/1bf-sec"2) 

c 

I 

INTEGER*2 

do loop Index 

c 

ISTRT 

INTEGER*2 

flag 

c 

KMAN 

REALM 

bulk modulus of manifold 
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c 

KTANK 

REALM 

bulk modulus of tank 

c 

L ( 75 ) 

REALM 

length of pipe section 

c 

LFLOW 

REALM 

flow rate through pipe 

c 

PCHMB 

REALM 

chamber pressure 

c 

PIPE1(75) 

REALM 

first parameter of fuel pipe description 

c 

PIPE2(75) 

REALM 

second parameter of fuel pipe description 

c 

PIPE3(75) 

REALM 

third parameter of fuel pipe description 

c 

PIPE4(75) 

REALM 

fourth parameter of fuel pipe description 

c 

SECTN(75) 

INTEGER*2 

pipe section types 

c 

SEGMN 

INTEGERS 

number of pipe sections 

c 

TFLOW 

REALM 

total flow rate of engine 

c 

TITLF 

CHAR*20 

title from fuel file 

c 

VALUE 

REALM 

Intermediate variable 

c 

VOL 

REALM 

volume of tank 

c 

c 

VOLMF 

REALM 

volume of manifold 

c 

c 

COMPLEX FUNCTION 

FUl(XL) 


c 

n 

Evaluates U1 



U 

c 

Commons CMPVAL 

INTVAL RELVAL 

c 


Variables 

In Argument List 

c 

XL 

REALM 

length of chamber 

c 


Local Variables 

c 

DX 

REALM 

Integration Increment 

c 

I 

INTEGER*2 

do loop Index 

c 

VINT 

C0MPLEX*8 

intermediate variable 

c 

c 

X 

REALM 

current x location 

c 

c 

SUBROUTINE GINERT(BEND,X,Y) 

c 

Evaluates curve fit of 

Inertance of bends 

Kj 

c 


Variables 

In Argument List 

c 

BEND 

REALM 

angle of bend (degrees) 

c 

X 

REALM 

ratio of Inner to outer radius 

c 

Y 

REALM 

Inertance 

c 


Local Variables 

c 

A 

REALM 

Intermediate variable 

c 

c 

B(3) 

REALM 

coefficient array for Inertance fit 

c 

c 

SUBROUTINE ITER(ID,TOL) 


c 

p 

Iterates for dependent variable 

c 

Commons CMPVAL 

INTVAL RELVAL RESULT 

c 


Variables 

In Argument List 

c 

ID 

INTEGER*2 

flag for dependent variable 

c 

TOL 

REALM 

convergence criteria 

c 


Local Variables 

c 

FUN 

REALM 

Intermediate variable 

c 

FUN1 

REALM 

Intermediate variable 
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c 

FUN 2 


REALM 

Intermediate variable 

c 

I 


INTEGERS 

do loop Index 

c 

VAL 


REALM 

Intermediate variable 

c 

VAL1 


REALM 

intermediate variable 

c 

c 

VAL 2 


REALM 

intermediate variable 

c 

c 

SUBROUTINE 

LOX ( S , GOX ) 


c 

r 

Handles 

lox 

piping logic 

c 

Common PIPES 



c 



Variables In Argument List 

c 

GOX 


COMPLEX*8 

admittance of lox line looking toward tank 

c 

S 


COMPLEX*8 

complex frequency 

c 



Local Variables 

c 

A 


REALM 

speed of sound In the fluid (ft/sec) 

c 

ANS 


CHARM 

response to question 

c 

AREA(75) 


REALM 

area of pipe section (ft" 2) 

c 

AREAS 


REALM 

Intermediate variable 

c 

CMAN 


REALM 

manifold capacitance 

c 

CTANK 


REALM 

tank capacitance 

c 

DENS 


REALM 

density of fluid 

c 

DIA(75) 


REALM 

diameter of pipe section 

c 

DIME 


REALM 

Intermediate variable 

c 

DPROR 


REALM 

pressure drop across orflces (lbf/ft"2) 

c 

FLOWL 


REALM 

Intermediate variable 

c 

GRAV 


REALM 

gravitational constant (lbm-ft/lbf-sec"2) 

c 

I 


INTEGERS 

do loop Index 

c 

ISTRT 


INTEGER*2 

flag 

c 

KMAN 


REALM 

bulk modulus of manifold 

c 

KTANK 


REALM 

bulk modulus of tank 

c 

L(75) 


REALM 

length of pipe section 

c 

LFLOW 


REALM 

flow rate through pipe 

c 

LOXIN 


CHAR*24 

name of file containing lox piping data 

c 

PCHMB 


REALM 

chamber pressure 

c 

PIPE1(75) 


REALM 

first parameter of fuel pipe description 

c 

PIPE2C75) 


REALM 

second parameter of fuel pipe description 

c 

PIPE3(75) 


REALM 

third parameter of fuel pipe description 

c 

PIPE4(75) 


REALM 

fourth parameter of fuel pipe description 

c 

SECTN(75) 


I NT EGER* 2 

pipe section types 

c 

SEGMN 


INTEGERS 

number of pipe sections 

c 

TFLOW 


REALM 

total flow rate of engine 

c 

TITLO 


CHAR* 20 

totle from lox file 

c 

VALUE 


REAL*4 

Intermediate variable 

c 

VOL 


REAL*4 

volume of tank 

c 

c 

VOLMF 


REALM 

volume of manifold 

c 

c 

SUBROUTINE 

NONDIM(HOLD) 



C Nondlmenslonal Izes variables 

C 

C Commons CMPVAL DIMVAL INTVAL PIPES RELVAL TITL 
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c 


Variables in Argument List 

c 

HOLD(20) 

REAL*4 

array for transferring variables 

c 


Local Variables 

c 

CAREA 

REAL*4 

area of chamber 

c 

CSTARD 

REAL*4 

intermediate variable 

c 

FAC 

REAL*4 

intermediate variable 

c 

GC 

REAL*4 

gravitational constant ( lbm-ft/lbf-sec" 

c 

I 

INTEGER*2 

do loop index 

c 

PEXIT 

REAL*4 

exit pressure 

c 

PI 

REAL*4 

mathematical constant 

c 

RFAR 

REAL*4 

intermediate variable 

c 

RHOBAR(50) 

REAL*4 

intermediate variable array 

c 

TAREA 

REAL*4 

throat area 

c 

UBARD(50) 

REAL*4 

intermediate variable array 

c 

VAR( 13) 

CHAR*8 

names of nondimensional variables 

c 

c 

VARD(20) 

CHAR*8 

names of dimensional variables 

c 

c 

SUBROUTINE PLTALL (X , Y , NOT , NOF , N , M , LABLX , LABLY , FREQ) 

c 

r 

Plots n vs 

t for all frequencies 

V*r 

c 

Commons FFACT 

TITL 


c 


Variables ■ 

in Argument List 

c 

FREQ (NOF) 

REAL*4 

frequency array 

c 

LABLX 

CHAR* 8 

label for x axis 

c 

LABLY 

CHAR*8 

label for y axis 

c 

M 

INTEGER*2 

number of frequencies 

c 

N 

INTEGER*2 

number of tau’s 

c 

NOF 

INTEGER*2 

maximum number of frequencies 

c 

NOT 

INTEGER*2 

maximum number of tau’s 

c 

X ( NOT ) 

REAL*4 

tau array 

c 

Y ( NOT , NOF ) 

REAL*4 

n array 

c 


Local Variables 

c 

ASPECT 

REAL*4 

intermediate variable 

c 

FREQL 

CHAR* 16 

label for frequency 

c 

I 

INTEGER*2 

do loop Index 

c 

I BOARD 

INTEGER*2 

flag for type of graphics board used 

c 

ICOLR 

INTEGER*2 

color flag 

c 

IEXTEN 

INTEGER*2 

extension of key hit 

c 

IFIL 

INTEGER*2 

color flag 

c 

I KEY 

INTEGER*2 

code of key hit 

c 

ILIN 

INTEGER*2 

color flag 

c 

IOPT 

INTEGER*2 

intermediate variable 

c 

IXLAB 

INTEGER*2 

Intermediate variable 

c 

IXPIX 

INTEGER*2 

intermediate variable 

c 

IYLAB 

INTEGER*2 

intermediate variable 

c 

IYPIX 

INTEGER*2 

intermediate variable 

c 

J 

INTEGER*2 

do loop index 

c 

JC0L1 

INTEGER*2 

starting plot column 

c 

JC0L2 

INTEGER*2 

ending plot column 

c 

JR0W1 

INTEGER*2 

starting plot row 

c 

JR0W2 

INTEGER*2 

ending plot row 
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c 

LABFAC(7) 

CHARM 

1 abe 1 s 

c 

MODE 

INTEGER*2 

graphics mode 

c 

MODET 

INTEGERS 

text mode 

c 

NCOLT 

INTEGER*2 

number oc text columns 

c 

RADHER(2) 

CHARM 

1 abe 1 s 

c 

XFAC 

REALM 

intermediate variable 

c 

XLABL(2) 

CHARM 

label 

c 

XMAJC 

REALM 

intermediate variable 

c 

XMAX 

REALM 

maximum x value for plot 

c 

XMIN 

REALM 

minimum x value for plot 

c 

XORG 

REALM 

plot x origin 

c 

YFAC 

REALM 

intermediate variable 

c 

YLABLC2) 

CHARM 

label 

c 

YMAJ 

REALM 

intermediate variable 

c 

YMAX 

REALM 

maximum y value for plot 

c 

YMIN 

REALM 

minimum y value for plot 

c 

YORG 

REALM 

plot y origin 

c 

c 

YOVERX 

REALM 

intermediate variable 

c 

c 

SUBROUTINE PLTVAR(X , Y , N , LABLX , LABLY , FREQ) 

c 

r 

Plots n vs 

x for a single frequency 

o 

c 

Commons FFACT 

TITL 


c 


Variables in Argument List 

c 

FREQ 

REALM 

frequency 

c 

LABLX 

CHARM 

label for x axis 

c 

LABLY 

CHARM 

label for y axis 

c 

N 

INTEGERS 

number of tau’s 

c 

X(N) 

REALM 

tau array 

c 

Y(N) 

REALM 

n array 

c 


Local Variables 

c 

ASPECT 

REALM 

intermediate variable 

c 

FREQL 

CHAR*29 

label for frequency 

c 

I 

INTEGERM 

do loop index 

c 

I BOARD 

INTEGERM 

flag for type of graphics board used 

c 

ICOLR 

INTEGERS 

color flag 

c 

IEXTEN 

INTEGER*2 

extension of key hit 

c 

IFIL 

INTEGER*2 

color flag 

c 

I KEY 

INTEGERM 

code of key hit 

c 

ILIN 

INTEGER*2 

color flag 

c 

I OPT 

INTEGER*2 

intermediate variable 

c 

IXLAB 

INTEGER*2 

intermediate variable 

c 

IYLAB 

I NT EGER* 2 

Intermediate variable 

c 

JCOL1 

I NT EGER* 2 

starting plot column 

c 

JCOL2 

INTEGER*2 

ending plot column 

c 

JROW1 

INTEGER*2 

starting plot row 

c 

JROW2 

INTEGER*2 

ending plot row 

c 

LABFAC(7) 

CHAR*8 

labels 

c 

MODE 

INTEGER*2 

graphics mode 

c 

MODET 

INTEGER*2 

text mode 

c 

NCOLT 

INTEGER*2 

number oc text columns 
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c 

RADHEFK2) 

CHAR*8 

labels 

c 

XFAC 

REALM 

intermediate variable 

c 

XLABL(2) 

CHAR*8 

label 

c 

XMAJ 

REALM 

intermediate variable 

c 

XMAX 

REALM 

maximum x value for plot 

c 

XMIN 

REALM 

minimum x value for plot 

c 

XORG 

REALM 

plot x origin 

c 

YFAC 

REALM 

intermediate variable 

c 

YLABL(2) 

CHAR* 8 

label 

c 

YMAJ 

REALM 

intermediate variable 

c 

YMAX 

REALM 

maximum y value for plot 

c 

YMIN 

REALM 

minimum y value for plot 

c 

YORG 

REALM 

plot y origin 

c 

c 

YOVERX 

REALM 

intermediate variable 

c 

c 

SUBROUTINE READIN 


c 

p 

Reads Input 

data 


c 

Commons CMPVAL 

DIMVAL INTVAL RELVAL TITL 

c 


Local Variables 

c 

ANS 

CHARM 

response to question 

c 

COIAM 

REALM 

chamber diameter (ft) 

c 

OCSDRD 

REALM 

d(cstar)/d(m1xture ratio) (ft/sec) 

c 

DHLDRD 

REALM 

d(enthalpy)/d(mixture ratio) (ft/sec)~2 

c 

DTAUD 

REALM 

delta time lag (sec) 

c 

GAMMAD 

REALM 

ratio of specific heats 

c 

HOLD(20) 

REALM 

equivalenced to dimensioned variables 

c 

I 

INTEGER*2 

do loop index 

c 

I GO 

INTEGER*2 

path flag 

c 

II 

INTEGER*2 

do loop Index 

c 

LAMDAD 

REAL*4 

real part of complex frequency 

c 

MBARD 

REAL*4 

mean combustion response function (lbm/sec) 

c 

MUD 

REAL*4 

imaginary part of complex frequency 

c 

NAME 

CHAR*8 

name of input parameter 

c 

ND 

REAL*4 

pressure Interaction index 

c 

NRD 

REALM 

enthalpy Interaction Index 

c 

PCHMB 

REALM 

chamber pressure ( lbf/ft~2) 

c 

POOD 

REALM 

maximum pressure at Injection face 

c 

RBARD 

REALM 

mean mixture ratio 

c 

RGAS 

REALM 

gas constant (ft~2/sec"2/*R) 

c 

RHOLOD 

REALM 

mass of liquid per unit chamber vol (lbm/ft 

c 

TAUD 

REALM 

sensitive time lag (sec) 

c 

TCHMB 

REALM 

chamber temperature (*R) 

c 

TDIAM 

REALM 

throat diameter (ft) 

c 

ULOD 

REALM 

axial component of liquid velocity (ft/sec) 

c 

VALUE 

REALM 

value of Input parameter 

c 

VAR (20) 

CHAR*8 

names of variables for printout 

c 

VARL(20) 

CHAR*8 

names of variables (lower case) 

c 

VARP(20) 

CHAR*8 

names of variables (upper case) 

c 

XLCD 

REAL*4 

x location of chamber-nozzle Interface (ft) 


c 
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c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


SUBROUTINE SETVAL(VAL, ID) 

Sets value from iterated variable 

Common DIMVAL 

Variables In Argument List 
ID INTEGER*2 pointer to variable 

VAL REALM value of variable 


SUBROUTINE SETVAR(VAL, ID) 

Sets iterated variable from value 


Commons CMPVAL 

DIMVAL INTVAL RELVAL RESULT 


Variables 

in Argument List 

ID 

INTEGERS 

pointer to variable 

VAL 

REALM 

value of variable 


Local Variables 

ASTAR 

REALM 

speed of sound at injector face 

CAREA 

REALM 

area of chamber 

CSTARD 

REALM 

intermediate variable 

FAC 

REALM 

intermediate variable 

GC 

REALM 

gravitational constant (lbm-ft/lbf-sec , '2) 

I 

INTEGER*2 

do loop index 

PI 

REALM 

mathematical constant 

RHOBAR 

REALM 

intermediate variable 

RHOB1 

REALM 

Intermediate variable 

TAREA 

REALM 

throat area 

UBARD 

REALM 

Intermediate variable 


SUBROUTINE ZREAD(NAME, VALUE) 

Reads 

input for input i 

modification 


Variables 

in Argument List 

NAME(8) 

CHARM 

name of input variable 

VALUE 

REALM 

value of input variable 


Local Variables 

BLK 

CHARM 

l > 

CARD (80) 

CHARM 

card Image 

CEND(3) 

CHARM 

’EVN’.’D’ 

COMMA 

CHARM 

1 > 
> 

DCARD 

CHAR*80 

card image 

E 

CHARM 

’E’ 

FRACT 

REALM 

fractional part of number 

I 

INTEGERS 

do loop Index 

I COUNT 

INTEGERS 

position counter 

ID 

INTEGERS 

position counter 

II 

INTEGERS 

position counter 

J 

INTEGERS 

do loop index 

JJ 

INTEGERS 

position counter 

LE 

CHARM 

’e’ 
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c 

LEND(3) 

CHAR*1 

’eVn’.’d’ 

c 

MINUS 

CHAR*1 

5 _ t 

c 

NUMBER(IO) 

CHAR*1 


c 

PERIOD 

CHAR*1 

> r 

c 

PLUS 

CHAR*1 


c 

POUND 

CHAR* 1 


c 

QUEST 

CHAR*1 

»?» 

c 

SIGN 

REAL*4 

sign of number or exponent 

c 

WHOLE 

REAL*4 

WHOLE PART OF NUMBER 


c 

INTERFACE TO SUBROUTINE 

1 clearscreen[FAR, C, ALIAS: “ clearscreen"] (area) 

INTEGER*2 area 
END 

EXTERNAL CLEARSCREEN 

COMMON /CMPVAL/X1 , Y1 , Z 1 , W1 , Ml , PO , PI , UO , U1 , RFH , RFK , RFP , 

* S , GF , GOX , RFA , RFC 

COMMON /RELVAL/N , TAU , DTAU , NR , RBAR , MBAR , GAMMA , POO , DHLDR , CSTAR , 

* DCSDR , RHOLO , ULO , LAMDA , MU , TAUT , UBAR ( 50 ) , XBAR ( 50 ) , XLC 
COMMON /RESULT/PP,UP,SIGP,FUNB 

COMMON /INTVAL/NVAL 

COMMON /DIMVAL/HOLDD(20) ,XBARD(50) ,PBAR(50) ,TBAR(50) 

COMMON /TITL/TITLE,TITLF, IHR, IMIN, AP, IYR, IMON, IDA Y 
COMMON /FFACT/FFAC 

INTEGER*2 IHR, IMIN, ISEC, 1100, IYR, IMON, IDAY 

CHARACTER*2 AM,PM,AP 

CHARACTERS TITLE 

CHARACTER*40 TITLF 

REAL YP( 200 , 50 ) , FREQ( 50 ) , TAULST ( 200 ) 

REAL MBAR, N, NR, LAMDA, MU, RVAR(13) 

COMPLEX S,X1,Y1,Z1,W1,M1,PO,P1,UO,U1,GF,GOX,RFH,RFK,RFP,RFA,RFC 
COMPLEX PP , UP , SIGP , FUNB , CVAR (17) 

EQUIVALENCE ( N , RVAR ( 1 ) ) , ( X 1 , CVAR ( 1 ) ) 

CHARACTERS VARP(3) 

CHARACTER* 1 ANS 

CHARACTER*24 ROCIN,ROCOUT ,ROCVAR 
CHARACTER*8 RADHER(2) 

DATA RADHER/’ rad/sec Hertz V 
DATA AM/’AM V*PM/’PM ’/ 

DATA VARP/’ n vtau-sec V MU V 
DATA TOL/.OOOl/ 

DATA NOT / 200/ , NOF/ 50/ 

DATA I 1/2/, ID/ 1/ 

1 F0RMAT(A8,1PE13.5,2X,A8,E13.5, ’ FUNB= ’ ,2E13.5) 

2 FORMAT (A) 

3 FORMAT (/3X, A8, 5X, A8, 5X, ’ FUNB(R) ’ ,5X, ’ FUNB(I)Y) 

4 F0RMAT(1P6E13.5) 

5 FORMAT (1H1/’ FREQUENCY = ’ , 1PE13. 5, A) 

6 FORMAT ( ’ " ’ , A , ’ " ’ ) 

7 FORMAT ( 2X , ’ “ ’ , A8 , ’ ” ’ , 3X , * " ’ , A8 , ) 

10 F0RMAT(A40,2X,I2.2, ,12.2, A2,3X,I2. 2, ,12.2, ,12.2) 

CALL GETTIMOHR, IMIN, ISEC, 1100) 
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CALL GETDAT(IYR, IMON, IDAY) 

IYR=IYR-1900 
IF(IHR. LT. 12) THEN 
AP=AM 
ELSE 
AP=PM 

IF(IHR.GT. 12) IHR=IHR-12 
ENDIF 

CALL CLEARSCREEN(O) 

WRITE (*, ’ (10X,A) ’ ) 

W^ITE(*, ’ (10X,A) " ) 

*1 

WRITE(*, ’ (10X,A) ’ ) 

*’l Welcome to SFREQ - an Intermediate Mode Program 

WRITE(*, ’ (10X,A) ’ ) 

WRITE(*, (10X,A) ’ ) 

*’| To send a plot to the printer 

WRITE(*, ’ (10X,A) ’ ) 

wllTE(«, ’(10X f A)’) 

*’| The computer MUST be In GRAPHICS mode 

WRITE(*, ’ (10X,A) ’ ) 

*’l 

WRITE(*,’(10X,A)’) 

*’| Hit PrScn to send the current plot to the printer 

WRITE(*, ’ (10X,A) ’ ) 

*1 

WRITE (*, ’ (10X,A) ’ ) 

FFAC=1.0 
WRITE(*,*)’ ’ 

WRITEC*,*)’ If you want frequency in rad/sec, hit enter.’ 
WRITE(*, ’ (A\) ’ ) ’ If you want It In Hertz, enter “H". ’ 
READ(* , ’ (A) ’ )ANS 

IF(ANS.EQ. ’H’.OR.ANS.EQ. ’h’) FFAC=6. 283185 
WRITE(*,*)’ * 

WRITE(*,*)’ Are the files you are using’ 

WRITE(*,*)’ IMODE.INP - Input data’ 

WRITE(*, *) ’ I MODE. OUT - output data’ 

WRITE(*,’(A\)’)’ Enter Y or N ’ 

READ(*,2)ANS 

IF(ANS.NE. ’N’.AND.ANS.NE. ’n’) THEN 
OPEN ( 1 5 , FI L E= ’ IMODE . INP ’ ) 

0PEN(16, FILE= ’ IMODE.OUT’ ) 

ELSE 

WRITE(*, ’ (A\) ’ ) ’ Enter name of file containing input ’ 

READ(*, 2)ROCIN 

OPEN(15,FILE=ROCIN) 

WRITE(* t ’ (A\) ’ ) ’ Enter name of file for output ’ 
READ(*,2)ROCOUT 
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OPEN( 16 , FILE=ROCOUT ) 

ENDIF 
XLC=1.0 
WRITE(*,*)’ ’ 

WRITE(*,*)’ ’ 

WRITE(*,*)’ ’ 

WRITE(*,*)’ ’ 

WRITE(*,*) ’ ’ 

WRITE(*,*)’ ’ 

WRITE(*,*)’ Welcome to IMODE’ 

WRITE (*,*) ’ ’ 

WRITE(*,*)’ Intermediate Mode Rocket Stability Aide’ 

WRITE(*,*) ’ ’ 

WRITE(*,*)’ There are three types of Input, rocket parameters,’ 
WRITE(*,*)’ Oxidizer feed parameters, and fuel feed parameters,’ 
WRITE(*,*) ’ Each may be read from files or from the keyboard’ 
WRITE(*,*) ’ ’ 

WRITE(*,*)’ File Name Input’ 

WRITE(* ,*) ’ ’ 

WRITE(*,*)’ IMODE. INP or NAME read In Rocket Parameters ’ 
WRITE(* , *) ’ LOX.INP Oxidizer Parameters’ 

WRITE(*,*)’ FUEL. INP Fuel Parameters 

WRITE(* , *) ’ ’ 

WRITE (*,*)’ If keyboard entry, you will be prompted for values’ 

GO TO 21 

20 CONTINUE 
WRITE(*,*) ’ ’ 

WRITE(*, ’ (A\) ’ ) ’ Do you want to run another case? Enter Y or N ’ 
READ(*,2)ANS 

IF(ANS. EQ. ’N’ .OR.ANS.EQ. ’n’) STOP 

21 CONTINUE 
CALL READIN 

22 CONTINUE 
WRITE(*,*) ’ ’ 

231 CONTINUE 

WRITE(*,*)’ Specify how frequency will be input -’ 

WRITE(*,*)’ Enter R for a range of values’ 

WRITE(*,*)’ Enter F for values in a file’ 

WRITE(*,*)’ Enter K (end with -999) to enter values ’, 

* ’from keyboard’ 

READ(* , 2)ANS 

IF(ANS. EQ. ’R’ .OR.ANS.EQ. ’ r’ ) THEN 
2310 CONTINUE 

IF(FFAC.EQ.l.O) THEN 

WRITE(*,*)’ Enter first and last values of frequency ’, 

* ’in rad/sec and no. of points.’ 

ELSE 

WRITE(*,*)’ Enter first and last values of frequency ’, 

* ’In hertz and no. of points.’ 

ENDIF 

READ( * , *)STARTF, STOPF , NPTF 
IF(NPTF.GT.NOF) THEN 
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WRITE(*,*) ’ No. of points must be <’,NOF 
GO TO 2310 
ENDIF 

IF(STOPF.EQ.O.O) STOPF=STARTF 
IF(NPTF.EQ.O) NPTF=1 
IF(NPTF.EQ.l) THEN 
DELF=0. 0 
ELSE 

DELF= (STOPF-STARTF)/ (NPTF-1 ) 

ENDIF 

DO 232 I=1,NPTF 

FREQ( I )=STARTF+DELF* ( 1-1 ) 

232 CONTINUE 
GO TO 23 

ENDIF 

IF(ANS.EQ. ’F’.OR.ANS.EQ. ’f’) THEN 
WRITE(*,*)’ Is the frequency on INODE. FRQ?’ 
WRITE(*,’(A\)’)’ Enter Y or N ’ 

READ(*,2)ANS 

IF(ANS.NE. ’N’.AND.ANS.NE. ’n’) THEN 
OPEN(19,FILE= ’ IMODE. FRQ’ ) 

ELSE 

WRITE(*, ’ (A\) ’ ) ’ Enter name of file for frequency ’ 
READ ( * , 2 ) ROCVAR 
OPEN ( 19 , FILE=ROCVAR) 

ENDIF 

READ(19,*)NPTF 
IF(NPTF.GT.NOF) THEN 
WRITE(*,*)’ Too many points for program* 

GO TO 231 
ENDIF 

DO 233 I=1,NPTF 
READ(19,*)FREQ(I) 

233 CONTINUE 
GO TO 23 

ENDIF 

IF(ANS.EQ. *K* .OR.ANS.EQ. *k’) THEN 
NPTF=0 

234 CONTINUE 
READ(*,*)VAR1 

IF(VAR1. EQ.-999) GO TO 23 
NPTF=NPTF+1 
FREQ(NPTF)=VAR1 
IF(NPTF.EQ.NOF) GO TO 23 
GO TO 234 
ELSE 

WRITE(*,*)’ R, F, or K not entered, try again!’ 

GO TO 231 
ENDIF 

23 CONTINUE 

WRITE(*,*)’ Specify how tau will be Input 
WRITE(*,*)’ Enter R for a range of values’ 
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WRITE(*,*) ’ Enter F for values In a file’ 

WRITE(*,*)’ Enter K to enter values from keyboard’ 
READ(*,2)ANS 

IF(ANS.EQ.’R’.OR.ANS.EQ.’r’) GO TO 24 
IF(ANS.EQ. ’F’.OR.ANS.EQ. ’f’) GO TO 26 
IF(ANS.EQ. ’K’.OR.ANS.EQ. ’k’) GO TO 28 
WRITE(*,*)’ R, F, or K not entered, try again!’ 

GO TO 23 

24 CONTINUE 

WRITE(*,*) ’ Enter first and last values of tau ’, 

* ’and no. of points.’ 

READ(* , * JSTARTV , STOPV , NPTS 
IF(NPTS.GT.NOT) THEN 

WRITE(*,*)’ No. of points must be <’,NOT 
GO TO 24 
ENDIF 

IF(STOPV.EQ.O.O) STOPV=STARTV 
IF(NPTS.EQ.O) NPTS=1 
IF(NPTS.EQ.l) THEN 
DELVAL=0. 0 
ELSE 

DELVAL=( STOPV- STARTV ) / ( NPTS- 1 ) 

ENDIF 

DO 25 1=1, NPTS 

TAULST ( I ) =STARTV+ ( I- 1 ) * DELVAL 

25 CONTINUE 
GO TO 30 

26 CONTINUE 

WRITE(*,*)’ Is tau on IMODE.TAU?’ 

WRITE(*, ’ (A\) ’ ) ’ Enter Y or N ’ 

READ(*,2)ANS 

IF(ANS.NE. ’N’.AND.ANS.NE. ’n’) THEN 
OPEN( 18 , FILE= ’ IMODE.TAU ’ ) 

ELSE 

WRITE(*, ’ (A\) ’ ) ’ Enter name of file for tau ’ 

READ(*,2)ROCVAR 

0PEN(18, FILE=ROCVAR) 

ENDIF 

READ(18,*)NPTS 
IF(NPTS.GT.NOT) THEN 
WRITE(*,*)’ Too many points for program’ 

GO TO 23 
ENDIF 

DO 27 1=1, NPTS 
READ(18,*)TAULST(I) 

27 CONTINUE 
GO TO 30 

28 CONTINUE 
NPTS=0 

29 CONTINUE 
WRITE(*, ’ (A\) ’ ) 

* ’ Enter new value for independent variable (-999 to stop) ’ 
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READ(*,*,END=99)VAR1 
IF(VAR1.EQ. -999.0) GO TO 30 
NPTS=NPTS+1 
TAULST(I)=VAR1 
IF(NPTS.EQ.NOT) GO TO 30 
GO TO 29 

30 CONTINUE 

DO 32 J=1 ,NPTF 
WRITE(16, 2)TITLE 
WRITE(16,3)VARP(II) ,VARP(ID) 

IF(FFAC.EQ.l.O) THEN 
WRITE ( 1 6 , 5 ) FREQ( J ) , RADHER ( 1 ) 

WRITE(*,5)FREQ(J),RADHER(1) 

ELSE 

WRITE(16,5)FREQ(J) ,RADHER(2) 

WRITE(*,5)FREQ(J),RADHER(2) 

ENDIF 

WRITE(*,3)VARP(II),VARP(ID) 

VAR1=FFAC*FREQ(J) 

CALL SETVAR(VAR1 ,6) 

DO 31 1=1 ,NPTS 
VAR1=TAULST(I) 

CALL SETVAR ( VAR1 ,11) 

CALL ITER(ID.TOL) 

WRITE(16, 4)HOLDD(II ) ,HOLDD(ID) ,FUNB 
WRITE (*,4)HOLDD( II) ,HOLDD(ID) ,FUNB 
YP(I , J)=HOLDD(ID) 

31 CONTINUE 

WRITE(*,’(A\)’) 

* ’ Do you wish to see n vs tau for this frequency? ’ 
READ(*,2)ANS 

IF(ANS. EQ. ’Y’.OR.ANS.EQ. ’y’) THEN 

CAL L PLTVAR ( TAULST , YP ( 1 , J ) , NPTS , VARP( II), VARP( I D ) , FREQ ( J ) ) 
ENDIF 

32 CONTINUE 

CALL PLTALL ( TAULST , YP , NOT , NOF , NPTS , NPT F , VARP ( 1 1 ) , VARP ( I D ) , FREQ ) 
GO TO 20 
99 CONTINUE 
STOP 
END 

SUBROUTINE ADMIT ( S , GADM , A , AREA , CMAN , CTANK , DPROR , L , LFLOW , PCHMB , 

* SEGMN.TFLOW) 

C determines admittance looking toward tank 

COMPLEX CT ANH , G ( 7 6 ) , GADM , S , W 
REAL AREA(75),L(75), LFLOW 
INTEGER SEGMN 

COMMON /DIMVAL/AJUNK1 ( 8 ) , XLCD , AJUNK2 ( 161 ) 

COMMON /PIPES/PFACE , TFACE , ASTAR 
DATA GRAV/32. 2/ 

W=S*ASTAR*2. 0/XLCD 

G(1)=CTANK*W 

GADM=G(1)+1.0 
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ZTOP=A*TFLOW/(GRAV*PCHMB) 

ZOR= 2 . 0*DPROR*TFLOW/ ( LFLOW*PCHMB ) 

DO 21 I=2,SEGMN+1 
ZLINE=ZTOP/AREA(I-l) 

TL=L(I-1)/A 

G(I)=(1.0+CTANH(W*TL)/(G(I-1)*ZLINE))/(1.0+G(I-1)*ZLINE* 

* CTANH(W*TL)) 

GADM=GADM*G(I) 

G(I)=G(I)*G(I-1) 

21 CONTINUE 

G(SEGMN+2)=1.0+CMAN«W/G(SEGMN+1) 

GADH= GADM*G ( SEGMN+ 2 ) 

G(SEGMN+2)=G(SEGMN+2)*G(SEGMN+1) 

G (SEGMN+3) = 1 . 0/ ( 1 . 0+ZOR*G (SEGMN+2 ) ) 

GADM=GADM*G(SEGMN+3) 

G ( S EGMN+ 3 ) = G ( S EGMN+ 3 ) *G ( S EGMN+ 2 ) 

GADM=G( SEGMN+3) 

RETURN 

END 

SUBROUTINE BENDS ( PI PEI , PIPE2 , PIPE3 , PIPE4 , VALUE , DIME ) 

C Computes effective straight pipe for bend 

REAL LBEND, INRAD, INERT, LPRME,NEWLN 
BENDR=0. 0174533*ABS( PIPE2 ) 

LBEND=PIPE1*BENDR 
ARBND=0. 785398*PIPE3**2 
INRAD=PIPEl-0. 5*PIPE3 
0TRAD=PIPEl+0. 5*PIPE3 
RATIO= INRAD/OTRAD 
X=RATIO 

CALL GINERT (ABS(PIPE2) ,X,Y) 

INERT= (Y*(OTRAD-INRAD) )/ARBND 
LPRME=LBEND/ARBND 
NEWLN=LPRME+INERT 
GAMMA= N EWLN/L PRME 
VALUE=GAMMA*(LBEND+2 . 0*PIPE4) 

AREAB= ARBND/SQRT ( GAMMA ) 

DIME=2.0*SQRT(AREAB/3. 1415927) 

RETURN 

END 

SUBROUTINE BOUND( PP , UP , SIGP , FUNB ) 

C Evaluates the boundary function 

COMMON /CMPVAL/X1 , Y1 , Z1 , W1 , Ml , PO , PI , UO , U1 , RFH , RFK , RFP , 

* S , GF , GOX , RFA , RFC 

COMMON /RELVAL/N , TAU , DTAU , NR , RBAR , MBAR , GAMMA , POO , DHLDR , CSTAR , 

* DCSDR , RHOLO , ULO , LAMDA , MU , TAUT , UBAR( 50 ) , XBAR( 50 ) , XLC 
COMMON /INTVAL/NVAL 

REAL MBAR, N, NR, LAMDA, MU 

COMPLEX S,X1 ,Y1 ,Z1,W1,M1 ,PO,P1,UO,GF,GOX, U1,RFH,RFK,RFP,RFA,RFC 
COMPLEX FP1 , FU1 , FSIGP , PP , UP , SIGP , FUNB , CSINH , CCOSH 
C EVALUATE PP, UP, SIGP, AND FUNB 

P1=FP1(XLC) 

U1=FU1(XLC) 
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PO=POO*CCOSH(S*XLC) 

U0=-(1. O/GAMMA )*POO*CSINH(S*XLC) 

PP=P0+P1 

UP=U0+U1 

SIGP=FSIGP(XLC) 

FUNB=UP+RFA*PP+RFC*SIGP 

RETURN 

END 

COMPLEX FUNCTION CCOSH(S) 

C Evaluates the complex hyperbolic cosine 

COMPLEX S 
REAL LAMDA, MU 
LAMDA=REAL(S) 

MU=AIMAG(S) 

COSHR= COSH ( LAMDA ) * COS ( MU ) 

COSHI=SINH( LAMDA )*SIN( MU) 

CCOSH=CMPLX ( COSHR , COSHI ) 

RETURN 

END 

COMPLEX FUNCTION CSINH(S) 

C Evaluates the complex hyperbolic sine 

COMPLEX S 
REAL LAMDA, MU 
LAMDA=REAL(S) 

MU=AIMAG(S) 

S I NHR= S I NH ( L AMDA ) * COS ( MU ) 

SINHI=COSH( LAMDA) ♦SIN (MU) 

CSINH=CMPLX(SINHR,SINHI) 

RETURN 

END 

COMPLEX FUNCTION CTANH(S) 

C Evaluates the complex hyperbolic tangent 

COMPLEX S , CTANN , CTAND , CSINH , CCOSH 
CTANN=CSINH(S) 

CT AND= CCOSH ( S ) 

CTANH=(0. 0,0.0) 

IF(CTAND.NE.O.O) CT ANH= CT ANN/CT AND 

RETURN 

END 

SUBROUTINE EVAL(X) 

C Evaluates parameters at a given x location 

COMMON /CMPVAL/X1 , Y1 , Z1 , W1 , Ml , PO , PI , UO , U1 , RFH , RFK , RFP , 

♦ S , GF , GOX , RFA , RFC 

COMMON /RELVAL/N , TAU , DTAU , NR , RBAR , MBAR , GAMMA , POO , DHLDR , CSTAR , 

* DCSDR , RHOLO , ULO , LAMDA , MU , TAUT , UBAR( 50 ) , XBAR ( 50 ) , XLC 
COMMON /INTVAL/NVAL 

REAL MBAR, N, NR, LAMDA, MU 

COMPLEX S,X1,Y1,Z1 ,W1 ,M1 ,P0,P1 ,U0,U1 ,GF,GOX,RFH,RFK,RFP,RFA,RFC 
COMPLEX CSINH, CCOSH 

C EVALUATE EVERYTHING EXCEPT PP,UP,SIGP 

IF(NVAL.EQ.l) THEN 
UB=UBAR(1) 
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GO TO 23 
ENDIF 

DO 21 1=2 ,NVAL 
IF(X.LE.XBARU)) GO TO 22 

21 CONTINUE 
UB=UBAR(NVAL) 

GO TO 23 

22 CONTINUE 

FAC= ( X-XBAR (I— l))/( XBAR ( I ) -XBAR ( I- 1 ) ) 

UB=UBAR( 1-1 )+FAC* (UBAR( I )-UBAR( 1-1 ) ) 

23 CONTINUE 

RFH= ( 1 . 0+RBAR ) * ( ( RBAR/CSTAR ) *DCSDR-NR*S*TAU ) * (GOX 

* -RBAR*GF)/RBAR 

RFK= ( 1 . 0+S*TAUT ) * ( GOX+GF ) 

RFP=N* ( 1 . 0-CEXP ( S*TAU ) ) 

PO=POO*CCOSH(S*X) 

U0=-( 1 . 0/GAMMA )*P00*CSINH(S*X) 

Xl= ( GAMMA- 1 . 0 ) *UB*UO+ ( 1 . 0+RBAR ) *DHLDR* ( MBAR/S ) 

* *CEXP(-S*TAUT)*(GOX-RBAR*GF)*POO 
Y1=-UB*P0 

Zl= ( 1 . 0/GAMMA ) *UB*PO+RHOLO*ULO 
W1=2.0*UB*U0 

M1=MBAR* ( CEXP ( -S*TAUT ) * ( RFK+RFH ) *POO-RFP*PO ) 

RETURN 

END 

COMPLEX FUNCTION FPl(XL) 

C Evaluates PI 

COMMON /CMPVAL/X1 , Y1 , Z1 , W1 , Ml , PO , PI , UO , U1 , RFH , RFK , RFP , 

* S , GF , GOX , RFA , RFC 

COMMON /RELVAL/N , TAU , DTAU , NR , RBAR , MBAR , GAMMA , POO , DHL DR , CSTAR , 

* DCSDR , RHOLO , ULO , LAMDA , MU , TAUT , UBAR( 50 ) , XBAR ( 50 ) , XLC 
COMMON /INTVAL/NVAL 

REAL MBAR, N, NR, LAMDA, MU 

COMPLEX S,X1 , Y1 , Z1 ,W1 ,M1 , PO , PI , U0,U1 , GF, GOX, RFH, RFK, RFP, RFA , RFC 
COMPLEX CSINH,CCOSH 
COMPLEX VINT 
C EVALUATE PI 

DX=XL/50. 0 
FP1=CMPLX(0. 0,0.0) 

DO 23 1=1,51 
X=(I-1)*DX 
CALL EVAL(X) 

VINT=(S*(W1-X1)+M1)*CSINH(S*(XL-X)) 

* +S*(Y1+Z1)*CC0SH(S*(XL-X) ) 

IF(I. EQ. l.OR. I . EQ. 51) THEN 

FP1=FP1+0.5*VINT*DX 

ELSE 

FP1=FP1+VINT*DX 

ENDIF 

23 CONTINUE 

FP1=-GAMMA*(W1+FP1) 

RETURN 
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END 

COMPLEX FUNCTION FSIGP(XL) 

C Evallates SIG’ 

COMMON /CMPVAL/X1 , Y1 , Z 1 , W1 , Ml , PO , PI , UO , U1 , RFH , RFK , RFP , 

* S , GF , GOX , RFA , RFC 

COMMON /RELVAL/N , TAU , DTAU , NR , RBAR , MBAR , GAMMA , POO , DHLDR , CSTAR , 

* DCSDR , RHOLO , ULO , LAMDA , MU , TAUT , UBAR( 50 ) , XBAR ( 50 ) , XLC 
COMMON /INTVAL/NVAL 

REAL MBAR , N , NR , LAMDA , MU 

COMPLEX S,X1,Y1,Z1,W1,M1,PO,P1,UO,U1,GF,GOX,RFH,RFK,RFP,RFA,RFC 
REAL UB(51) 

COMPLEX VINT ( 5 1 ) , WINT ( 51 ) , FSIG2 , FCON 
C EVALUATE FSIGP (INTEGRATION NOT CHANGED YET) 

DX=XL/50.0 
DO 23 1=1,51 
X=(I-1)*DX 
IF(NVAL.EQ.l) THEN 
UB(I)=UBAR(1) 

GO TO 23 
ENDIF 

DO 21 11=2, NVAL 
IF(X. LE.XBAR(II)) GO TO 22 

21 CONTINUE 

II=NVAL 

22 CONTINUE 

FAC= (X-XBAR( II-l ) )/(XBAR( II )-XBAR(II-l) ) 

UB( I )=UBAR( II-l )+FAC*(UBAR( II )-UBAR(II-l) ) 

23 CONTINUE 

DO 24 1=1,51 
X=(I-1)*DX 
CALL EVAL(X) 

V I NT ( I ) = ( ( GAMMA- 1 . 0)/GAMMA)*P0 
VVINT(I)=1.0/UB(I) 

24 CONTINUE 

FCON= ( 1 . 0+RBAR)*DHLDR* (GOX-RBAR*GF)*POO 

* *CEXP(-S*TAUT) 

DO 26 1=1,51 

FSIG2=CMPLX(0. 0,0.0) 

DO 25 J=I , 51 

I F ( J . EQ . I . OR . J . EQ . 5 1 ) THEN 
FSIG2=FSIG2+0. 5*VVINT(J)*DX 
ELSE 

FSIG2=FSIG2+VVINT ( J )*DX 
ENDIF 

25 CONTINUE 

FSIG2=CEXP(-S*FSIG2) 

VINT ( I )= (VINT ( I )+FCON)*MBAR*FSIG2 

26 CONTINUE 
FSIGP=CMPLX(0. 0,0.0) 

DO 27 1=1,51 

IF(I.EQ.1.0R.I.EQ.51) THEN 
FSIGP=FSIGP+0. 5*VINT(I)*DX 
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ELSE 

FSIGP=FSIGP+VINT(I)*DX 

ENDIF 

27 CONTINUE 

FSIGP=-FSIGP/UB( 51 ) 

RETURN 

END 

SUBROUTINE FUEL(S,GF) 

C Handles fuel piping logic 

COMMON /PIPES/PFACE,TFACE,ASTAR 
COMPLEX GF,S 

REAL AREA ( 75 ) , DIA( 75 ) , L ( 75 ) , KMAN , KTANK , LFLOW 
REAL PIPE1(75) ,PIPE2(75) ,PIPE3(75) ,PIPE4(75) 

INTEGER SEGMN,SECTN(75) 

CHARACTER*24 FUELIN 
CHARACTER*20 TITLF 
CHARACTER* 1 ANS 
DATA ISTRT/0/.GRAV/32.2/ 

1 FORMAT (E15. 6) 

2 FORMAT (I5,4E15.6) 

IF(ISTRT.EQ.O) THEN 

ISTRT=1 

WRITE(*,*) ’ Is the file with fuel line data FUEL.INP?’ 
WRITE(*, ' (A\) ’ ) ’ Enter Y or N ’ 

READ(* , ’ (A) ’ )ANS 

IF(ANS.NE. ’N’ .AND. ANS. NE. ’n’ ) THEN 
OPEN(UNIT= 1 1 , FILE= ’ FUEL . INP ’ ) 

ELSE 

WRITE(*, ’ (A\) ’ ) ’ Enter name of file with fuel line data ’ 
READ(«, ’ (A) ’ )FUELIN 
OPEN(ll, FI LE= FUELIN) 

ENDIF 

C FUEL TITLE 

READ(11, ’ (A) ’ )TITLF 
C TANK CONDITIONS 

READ(11, l)VOL 
READ(1 1,1) LFLOW 
READ(1 1,1) KTANK 
C MANIFOLD CONDITIONS 

READd 1,1) DENS 
READ(11, l)TFLOW 
READ(ll,l)VOLMF 
READ (11,1) KMAN 
READ(11,1)PCHMB 
C ORFICE CONDITION 

READ(11 , l)DPROR 
A=SQRT(GRAV*KTANK/DENS) 

CTANK= ( DENS*VOL*PCHMB)/( KTANK*TFLOW) 

CMAN= ( DENS*VOLMF*PCHMB)/(KMAN*TFLOW) 

C PIPING 

READ(11,2)SEGMN 
DO 21 1=1 ,SEGMN 
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READ (11,2 ) SECTN ( I ) ,PIPE1(I ) , PIPE2(I) ,PIPE3(I) ,PIPE4(I) 
IF(SECTN(I).EQ.O) THEN 

CALL BENDS ( PIPE1 ( I ) , PIPE2 ( I ) , PIPE3( I ) , PIPE4( I ) , VALUE , DIME ) 
ELSE 

VALUE=PIPE1(I) 

DIME=PIPE2(I) 

ENDIF 

AREAB=0. 785398*DIME**2 
L(I)=VALUE 
AREA(I)=AREAB 
DIA(I)=DIME 
21 CONTINUE 
ENDIF 

FLOWL=LFLOW*TFACE/TFLOW 

CTANK= ( DENS*VOL*PFACE)/ ( KTANK*TFACE) 

CMAN=(DENS*VOLMF*PFACE)/(KMAN*TFACE) 

CALL ADMIT (S , GF , A , AREA , CMAN , CTANK, DPROR , L , FLOWL , PFACE , 

* SEGMN.TFACE) 

RETURN 

END 

COMPLEX FUNCTION FUl(XL) 

C Evaluates U1 

COMMON /CMPVAL/X1 , Y1 , Z1 , W1 , Ml , PO , PI , UO , U1 , RFH , RFK , RFP , 

* S , GF , GOX , RFA , RFC 

COMMON /R E L VAL/N , TAU , DT AU , NR , RBAR , MBAR , GAMMA , POO , DHL DR , CSTAR , 

* DCSDR , RHOLO , ULO , LAMDA , MU , TAUT , UBAR ( 50 ) , XBAR ( 50 ) , XLC 
COMMON /INTVAL/NVAL 

REAL MBAR ,N, NR, LAMDA, MU 

COMPLEX S,X1 ,V1 ,Z1 ,W1 ,M1,P0,P1 ,U0,U1 ,GF,GOX,RFH,RFK,RFP,RFA,RFC 
COMPLEX CSINH.CCOSH 
COMPLEX VINT 
C EVALUATE U1 

DX=XL/50. 0 
FU1=CMPLX(0. 0,0.0) 

DO 23 1=1,51 
X=(I-1)*DX 
CALL EVAL(X) 

VINT=(S*(W1-X1)+M1)*CC0SH(S*(XL-X)) 

* +S*(Y1+Z1)*CSINH(S*(XL-X)) 

IFU.EQ.1.0R.I.EQ.51) THEN 

FU1=FU1+0.5*VINT*DX 

ELSE 

FU1=FU1+VINT*DX 

ENDIF 

23 CONTINUE 
FU1=Y1+FU1 
RETURN 
END 

SUBROUTINE GINERT(BEND,X,Y) 

C Evaluates curve fit of Inertance of bends 

DIMENSION B(3) 

DATA B/0.0,0. 7877014E-02 , -0 . 2814679E-04/ 
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A=B(1)+(B(2)+B(3)*BEND)*BEND 

Y=A*(X-1.0)**2 

RETURN 

END 

SUBROUTINE ITER(ID,TOL) 

C Iterates for dependent variable 

COMMON /CMPVAL/X1 , Y1 , Z 1 , W1 , Ml , PO , PI , UO , U1 , RFH , RFK , RFP , 

* S , GF , GOX , RFA , RFC 

COMMON /RELVAL/N , TAU , DTAU , NR , RBAR , MBAR , GAMMA , POO , DHLDR, CSTAR , 

* DCSDR , RHOLO , ULO , LAMDA , MU , TAUT , UBAR ( 50 ) , XBAR ( 50 ) , XLC 
COMMON /INTVAL/NVAL 

COMMON /RESULT/PP , UP , SIGP , FUNB 
REAL MBAR , N , NR , LAMDA , MU , RVAR (13) 

COMPLEX S,X1,Y1,Z1,W1 ,M1 ,P0,P1 ,U0,U1 ,GF,GOX,RFH,RFK,RFP,RFA,RFC 
COMPLEX PP, UP, SIGP, FUNB, CVAR(17) 

EQUIVALENCE (N,RVAR( 1 ) ) , (XI , CVAR( 1 ) ) 

CALL SETVAL(VALl.ID) 

CALL BOUND(PP, UP, SIGP, FUNB) 

FUN 1=REAL( FUNB) 

IF(ABS(FUN1) . LE.TOL) GO TO 22 
VAL2=1.01*VAL1 
IF(VALl.EQ.O) VAL2=0. 01 
CALL SETVAR(VAL2 , ID) 

CALL BOUND(PP, UP, SIGP, FUNB) 

FUN2=REAL(FUNB) 

IF(ABS(FUN2). LE.TOL) GO TO 22 
IF(FUN1.EQ.FUN2) THEN 
VAL=VAL1+VAL2 
ELSE 

VAL=VAL1-FUN1*(VAL2-VAL1 )/ ( FUN2-FUN1 ) 

ENDIF 

IF(ABS(FUN2) . LT. ABS(FUN1 ) ) THEN 
FUN=FUN2 
FUN2=FUN1 
FUN 1= FUN 
VAL=VAL2 
VAL2=VAL1 
VAL1=VAL 
ENDIF 

DO 21 1=1,20 
CALL SETVAR(VAL.ID) 

CALL BOUND(PP, UP, SIGP, FUNB) 

FUN=REAL(FUNB) 

IF(ABSCFUN). LE.TOL) GO TO 22 
I F ( ABS ( FUN ) . LT . ABS ( FUN 1 ) ) THEN 
FUN2=FUN1 
FUN 1= FUN 
VAL2=VAL1 
VAL1=VAL 
ELSE 

FUN2=FUN 

VAL2=VAL 
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ENDIF 

IF(FUN1. EQ. FUN2) THEN 
IF(VAL1. EQ. VAL2) THEN 
VAL=VAll+VAL2 
ELSE 

VAL=0.5*(VAL1+VAL2) 

ENDIF 

ELSE 

VAL=VAL1-FUN1* (VAL2-VAL1 )/( FUN2-FUN1 ) 

ENDIF 

21 CONTINUE 

WRITE (*,*) ’ FAILED TO CONVERGE after 20 iterations’ 

22 CONTINUE 
RETURN 
END 

SUBROUTINE LOX(S,GOX) 

C Handles lox piping logic 

COMMON /PIPES/PFACE , TFACE , AST AR 
COMPLEX GOX,S 

REAL AREA(75),DIA(75) , L ( 7 5 ) ,KMAN,KTANK,LFLOW 
REAL PIPE1(75),PIPE2(75),PIPE3(75),PIPE4(75) 

INTEGER SEGMN,SECTN(75) 

CHARACTER*24 LOXIN 
CHARACTERS TITLO 
CHARACTER* 1 ANS 
DATA ISTRT/O/ , GRAV/32 . 2/ 

1 F0RMAT(E15. 6) 

2 FORMAT (I5,4E15.6) 

IF(ISTRT.EQ.O) THEN 

ISTRT=1 

WRITE(*,*)’ Is the file with lox line data LOX.INP?’ 
WRITE(* , ’ (A\) * ) ’ Enter Y or N ’ 

READ(* , ’ (A) ’ )ANS 

IF(ANS. NE. ’N’ .AND. ANS. NE. ’n’ ) THEN 
0PEN(UNIT=10, FILE= ’ LOX.INP’) 

ELSE 

WRITE(*, ’ (A\) ’ ) ’ Enter name of file with lox line data ’ 
READ(* , ’ (A) ’ )LOXIN 
OPEN ( 10, FILE= LOXIN) 

ENDIF 

C LOX TITLE 

READ(10, ’ (A) ’ )TITLO 
C TANK CONDITIONS 

READ(10, l)VOL 
READ(10, l)LFLOW 
READ(10, 1)KTANK 
C MANIFOLD CONDITIONS 

READ(10, 1)DENS 
READ(10, l)TFLOW 
READ(10, l)VOLMF 
READ(10, 1)KMAN 
READ(10,1)PCHMB 
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C ORFICE CONDITION 

READ(10,1)DPROR 
A=SQRT ( GRAV*KTANK/DENS ) 

CTANK= ( DENS*V0L*PCHM8)/ ( KTANK*TFLOW) 
CMAN=(DENS*VOLMF*PCHMB)/(KMAN*TFLOW) 

C PIPING 

READ(10,2)SEGMN 
DO 21 I=1,SEGMN 

READ( 10 , 2 )SECTN( I ) , PIPE1 ( I ) , PIPE2 ( I ) , PIPE3( I ) , PIPE4( I ) 
IF(SECTN(I). EQ.O) THEN 

CALL BENDS ( PIPE1 ( I ) , PIPE2 ( I ) , PIPE3 ( I ) , PIPE4( I ) , VALUE , DIME ) 
ELSE 

VALUE=PIPE1(I) 

DIME=PIPE2(I) 

ENDIF 

AREAB=0. 785398*DIME**2 
L(I)=VALUE 
AREA(I)=AREAB 
DIA(I)=DIME 
21 CONTINUE 
ENDIF 

FLOWL=LFLOW*TFACE/TFLOW 

CTANK= ( DENS*VOL*PFACE )/ ( KTANK*T FACE ) 

CMAN= ( DENS*VOLMF*PFACE )/ ( KMAN*TFACE ) 

CALL ADMIT ( S , GOX , A , AREA , CMAN , CTANK , DPROR , L , FLOWL , PFACE , 

* SEGMN.TFACE) 

RETURN 

END 

SUBROUTINE NONDIM(HOLD) 

C Nondlmenslonallzes variables 

COMMON /CMPVAL/X1 , Y1 , Z 1 , W1 , Ml , PO , PI , UO , U1 , RFH , RFK , RFP , 

* S , GF , GOX , RFA , RFC 

COMMON /RELVAL/N , TAU , DTAU , NR , RBAR , MBAR , GAMMA , POO , DHLDR , CSTAR , 

* DCSDR , RHOLO , ULO , LAMDA , MU , TAUT , UBAR ( 50 ) , XBAR( 50 ) , XLC 
COMMON /INTVAL/NVAL 

COMMON /DIMVAL/HOLDD(20) ,XBARD(50) ,PBAR(50) ,TBAR(50) 

COMMON /PIPES/PFACE,TFACE,ASTAR 

COMMON /TITL/TITLE,TITLF,IHR,IMIN,AP,IYR,IMON,IDAY 

INTEGER*2 IHR, IMIN.IYR, IMON, IDAY 

CHARACTER*2 AP 

CHARACTER*60 TITLE 

CHARACTER*40 TITLF 

REAL MBAR , N , NR , LAMDA , MU , RVAR( 15 ) 

REAL MBARD , ND , NRD , LAMDAD , MUD 
REAL HOLD(20) , UBARD(50) ,RHOBAR(50) 

COMPLEX S,X1,Y1,Z1,W1,M1,PO,P1,UO,U1,GF,GOX,RFH,RFK,RFP,RFA,RFC 
COMPLEX CVAR (17) 

CHARACTER*8 VAR(13),VARD(20) 

EQUIVALENCE ( N , RVAR ( 1 ) ) , ( XI , CVAR ( 1 ) ) 

EQUIVALENCE 

* ( ND , HOL DD ( 1 ) ) , ( T AUD , HOLDD ( 2 ) ) , ( DTAUD , HOLDD ( 3 ) ) , 

* (NRD, H0LDD(4)), (LAMDAD, H0LDD(5)), (MUD, H0LDD(6)), 
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* (CDIAM,H0LDD(7)) , (TDIAM, H0LDD(8)) , (XLCD,H0LDD(9) ) , 

* ( GAMMAD , HOLDD ( 1 0 ) ) , ( RGAS ,HOLDD(11)),(POOD,HOLDD(12)), 

* ( MBARD , HOLDD( 1 3 ) ) , ( RBARD , HOLDD( 14 ) ) , ( DCSDRD , HOLDD ( 1 5 ) ) , 

* ( DHLDRD , HOLDD( 16) ) , ( RHOLOD , HOLDD( 17 ) ) , (ULOD, HOLDD( 18 ) ) , 

* ( PCHMB , HOLDD( 19 ) ) , ( TCHMB , HOLDD( 20 ) ) 


DATA VAR/ 1 

N= 

TAU= 1 , ’ 

DTAU= ’ , ’ 

NR= ’ , ’ 

RBAR= * , 

t 

MBAR= ’ , ’ 

GAMMA= ’ , ’ 

P00= ’ , ’ 

DHLDR= ’ , ’ 

CST AR= ’ , 

* 

DCSDR= ’ , ’ 

RHOLO= * , ’ 

ULO= ’ / 



DATA VARD/’ 

N = ’,’ 

TAU = V 

DTAU = ’ , ’ 

NR ’ 

LAMDA =’ 

* 

MU = ’ , ’ 

CDIAM 

TDIAM ’ 

XLC = ’ , ’ 

GAMMA =’ 

* 

RGAS ’ 

POO = ’,’ 

MBAR = ’,’ 

RBAR ’ 

DCSDR =’ 

* ’ 

DHLDR = \ ’ 

RHOLO = ’,’ 

ULO ’ 

PCHMB 

TCHMB = ’ 


DATA PI/3. 141593/, GC/32. 174/ 

1 FORMAT (A) 

2 FORMAT ( A8 , 1 PEI 3 . 5 , 2X , A8 , E 1 3 . 5 , 2X , A8 , El 3 . 5 ) 

3 FORMAT (’ ’) 


C 

N 

- 

HOLD(l) 


C 

TAU 

- 

HOLD(2) 


c 

DTAU 

- 

HOLD(3) 


c 

NR 

- 

HOLD(4) 


c 

LAMDA 

- 

HOLD(5) 


c 

MU 

- 

HOLD(6) 


c 

CDIAM 


HOLDC7) 


c 

TDIAM 


HOLD(8) 


c 

XLC 

- 

HOLD(9) 


c 

GAMMA 

- 

HOLD(IO) 


c 

RGAS 

- 

HOLD(ll) 


c 

POO 

- 

HOLD(12) 


c 

MBAR 

- 

HOLD(13) 


c 

RBAR 

- 

HOLD(14) 


c 

DCSDR 

- 

HOLD(15) 


c 

DHLDR 

- 

HOLD( 16) 


c 

RHOLO 

- 

HOLD( 17 ) 


c 

ULO 

- 

HOLD(18) 


c 

PCHMB 

- 

HOLD(19) 


c 

TCHMB 

- 

HOLD(20) 


c 

PBAR 

- 

PBAR 


c 

TBAR 

- 

TBAR 


c 

XBAR 

- 

XBARD 


c 





c 

PCHMB 


PBAR(l) 


c 

TFLOW 

= 

LFLOW(LOX) + 

LFLOW(FUEL) 

c 

LFLOW 

r 

LINE FLOW OF 

LOX OR FUEL 

c 






DO 21 1=1,20 




HOLDD(I)=HOLD(I) 

21 CONTINUE 

IF(PCHMB.NE.PBAR(1)) THEN 
FAC= PCHMB/PBAR ( 1 ) 

DO 22 1=1 ,NVAL 
PBAR ( I ) = FAC* PBAR ( I ) 
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22 CONTINUE 
ENDIF 

IF(TCHMB.NE.TBAR(1)) THEN 
FAC=TCHMB/TBAR( 1 ) 

DO 23 I=1,NVAL 
TBAR(I)=FAC*TBAR(I) 

23 CONTINUE 
ENDIF 

CAREA=0. 25*PI*CDIAM**2 
WRITE(16,3) 

WRITE(16,*)’ CAREA= ’ ,CAREA 
TAREA=0 . 25*PI*TDIAM**2 
WRITE(16,*) ’ TAREA= ’ ,TAREA 
PFACE=PBAR(1) 

PEXIT = PBAR ( NVAL ) 

TFACE=MBARD 

ASTAR=SQRT(GAMMAD*RGAS*TBAR( 1 ) ) 

WRITE (16,*)’ ASTAR= ’ , ASTAR 
CSTARD=PEXIT*TAREA*GC/MBARD 
WRITE (16,*)’ CSTARD= ’ .CSTARD 
DO 24 1=1, NVAL 

RHOBAR ( I ) = PBAR ( I ) *GC/ ( RGAS*TBAR (I)) 
WRITE (16,*)’ RHOBAR= ’ , RHOBAR ( I ) 

UBARD ( I ) =MBARD/( RHOBAR ( I ) *CAREA ) 

WRITE (16,*)’ UBARD= ’ ,UBARD(I) 

24 CONTINUE 
N=ND 

TAU=TAUD*ASTAR/XLCD 

DT AU= DT AUD* AST AR/XLCD 

TAUT=TAU+DTAU 

NR=NRD 

RBAR=RBARD 

MBAR=HBARD/ ( RHOBAR ( 1 ) *AST AR*CAREA/XLCD ) 

GAMMA=GAMMAD 

P00=P00D/PBAR( 1 ) 

DHLDR=DHLDRD 
CST AR= CST AR D/ AST AR 
DCSDR= DCSDRD/AST AR 
RHOLO= RHOLOD/RHOBAR ( 1 ) 

ULO= ULOD/AST AR 
LAMDA=LAMDAD*XLCD/ASTAR 
MU=MUD*XLCD*PI/ASTAR 
XLC=1 . 0 

DO 25 1=1, NVAL 
XBAR( I )=XBARD( I )/XLCD 
UBAR ( I ) = UBARD ( I ) /ASTAR 

25 CONTINUE 
S=CMPLX(LAMDA,MU) 

CALL FUEL(S.GF) 

CALL LOX(S.GOX) 

RFAR= ( GAMMA- 1 . 0 ) *UBAR ( 1 ) / ( 2 . 0*GAMMA ) 
RFA=CMPLX ( RFAR ,0.0) 
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RFC=CMPLX(0. 0,0.0) 

WRITE(*,*)’ ’ 

WRITE(*,1)TITLE 

WRITE(*,*)’ DIMENSIONAL VARIABLES’ 

WRITE(*,’(” NVAL= ’ ’ , 15) ’ )NVAL 

WRITE(*, ’(” XBAR=” , 1P4E13. 5/(8X,4E13.5) ) ’ ) (XBARD(I) , 1 = 1 ,NVAL) 

WRITE(*, ’(” UBAR=” , 1P4E13. 5/(8X,4E13. 5) ) ’ ) (UBARD(I ) , 1 = 1 ,NVAL) 

WRITE(*,2)(VARD(I),HOLDD(I),I=1,20) 

WRITE(16,3) 

WRITE(16, UTITLE 
WRITE(16,3) 

WRITE(16,*)’ DIMENSIONAL VARIABLES’ 

WRITE(16,’(” NVAL= ” , 15) ’ )NVAL 

WRITE(16, ’(” XBAR= ’ ’ , 1P4E13 . 5/(8X , 4E13 . 5) ) ’ ) (XBARD( I ) , 1= 1 , NVAL ) 

WRITE(16, ’ ( ” UBAR=’ ’ , 1P4E13. 5/(8X,4E13. 5) ) ’ )(UBARD(I) , 1=1 ,NVAL) 
WRITE( 16 , 2 ) (VARD( I ) , H0LDD( I ) , 1=1 , 20) 

WRITE(*,*)’ NON-DIMENSIONAL VARIABLES’ 

WRITE(* , ’ ( ” NVAL= ” , 15) ’ )NVAL 

WRITE(», ’(” XBAR= ’ ’ , 1P4E13. 5/(8X,4E13. 5)) ’ ) (XBAR(I) , 1=1 , NVAL) 
WRITE(*,’(” UBAR= ’ ’ , 1P4E13. 5/(8X,4E13.5) ) ’ )(UBAR(I ) , 1=1 , NVAL) 

WRITE(*, ’(” S=” ,1P2E13.5)’)LAMDA,MU 

WRITE(*, 2) (VAR(I ) ,RVAR(I) ,1=1,13) 

WRITE(*,’(” GF= ’ ’ , 1P2E13. 5,5X, ’ ’ GOX= ” ,2E13. 5) ’ )GF,GOX 

WRITE(*,’(” RFA=”,1P2E13.5,5X,” RFC= ” , 2E13. 5) ’ )RFA,RFC 

WRITE(16,3) 

WRITE(16,*)’ NON-DIMENSIONAL VARIABLES’ 

WRITE(16,’(” NVAL= ” , 15) ’ )NVAL 

WRITE(16, ’(” XBAR= ”, 1 P4E 1 3 . 5/ ( 8X , 4E13 . 5 ) ) ’ ) ( XBAR ( I ) , I = 1 , NVAL ) 

WRITE(16, ’(” UBAR= ’ ’ , 1P4E13. 5/(8X,4E13.5) ) ’ ) (UBAR( I ) , 1=1 , NVAL) 

WRITE(16, ’(” S=” ,1P2E13.5)’)LAMDA,MU 

WRITE (16, 2) (VAR (I ) ,RVAR(I) ,1=1,13) 

WRITE(16, ’ ( ” GF=” ,1P2E13.5,5X, ” GOX= ” , 2E13. 5) ’ )GF,GOX 

WRITE(16,’(” RFA=” , 1P2E13. 5,5X, ” RFC= ” , 2E13 . 5 ) ’ )RFA,RFC 

WRITE(*, ’ (A\) ’ ) ’ Hit ENTER to continue ’ 

READ(*,*) 

RETURN 

END 

SUBROUTINE PLTALL ( X , Y , NOT , NOF , N , M , LABLX , LABLY , FREQ ) 

C Plots n vs t for all frequencies 

DIMENSION X ( NOT ) , Y ( NOT , NOF ) , FREQ (NOF) 

CHARACTER* 8 LABLX, LABLY, LABFAC( 7) 

CHARACTERS XLABL ( 2 ) , YLABL ( 2 ) 

CHARACTER* 16 FREQL 

COMMON /TITL/TITLE ,TITLF, IHR, IMIN, AP, IYR, IMON, IDAY 

INTEGER*2 IHR, IMIN, IYR, IMON, IDAY 

CHARACTER*2 AP 

CHARACTER*60 TITLE 

CHARACTER*40 TITLF 

COMMON /FFACT/FFAC 

CHARACTER*8 RADHER(2) 

DATA RADHER/’ rad/sec’,’ Hert 2 ’/ 

DATA LABFAC/ ’ ’ , ’ X 10 ’ , ’ x 100 ’,’ x 1000 ’, 
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* ’ x-10 x-100 V x-1000 ’/ 

DATA ASPECT/ 1.35/ 

1 FORMAT ( F8 . 1 , A ) 

CALL QRMODE ( MODET , NCOLT ) 

CALL QVIDBD(IBOARD) 

I F( I BOARD . LT . 1 . OR . I BOARD . GT . 3 ) THEN 
WRITEC*,*) ’ Graphics board not Installed!’ 

RETURN 

ENDIF 

IF(IBOARD.EQ.l) MODE=6 
IF(IBOARD.EQ.2) MODE=16 
IFUBOARD.EQ.3) MODE=18 
YMIN=Y(1, 1) 

YMAX=Y(N, 1) 

XMIN=X(1) 

XMAX=X(N) 

DO 21 1=1, N 

IF(XMIN.GT.X(I)) XMIN=X( I ) 

IF(XMAX.LT.X(I)) XMAX=X( I ) 

DO 21 J=1,M 

IF(YMIN.GT. Y(I, J) ) YMIN=Y(I,J) 

IF(YMAX.LT.Y(I,J)) YMAX=Y(I,J) 

21 CONTINUE 

IF(YMIN.GT.O.O) YMIN=0.0 
IXLAB= 1 

IF(XMAX.LT.O.l) IXLAB=2 
IF(XMAX.LT.O.Ol) IXLAB=3 
IF(XMAX.LT. 0.001) IXLAB=4 
IFCXMAX.GT. 10.0) IXLAB=5 
IFCXMAX.GT. 100.0) IXLAB=6 
IFCXMAX.GT. 1000.0) IXLAB=7 
IYLAB=1 

IFCYMAX.LT.0.1) IYLAB=2 
IFCYMAX.LT. 0.01) IYLAB=3 
IFCYMAX.LT. 0.001) IYLAB=4 
IFCYMAX.GT.10.0) IYLAB=5 
IFCYMAX.GT. 100.0) IYLAB=6 
IFCYMAX.GT. 1000.0) IYLAB=7 
IFCIXLAB.NE.1) THEN 
IFCIXLAB.EQ.2) XFAC=10.0 
IFCIXLAB.EQ.3) XFAC=100.0 
IFCIXLAB.EQ.4) XFAC=1000.0 
IFCIXLAB.EQ.5) XFAC=0.01 
IFCIXLAB.EQ.6) XFAC=0.001 
IFCIXLAB.EQ.7) XFAC=0.0001 
XMIN=XMIN*XFAC 
XMAX=XMAX*XFAC 
DO 22 1=1 ,N 
X(I)=X(I)*XFAC 

22 CONTINUE 
ENDIF 

IF(IYLAB.NE.l) THEN 
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IFUYLAB.EQ.2) YFAC=10.0 
IF(IYLAB.EQ.3) YFAC=100.0 
IF(IYLAB.EQ.4) YFAC=1000.0 
IF(IYLAB.EQ.5) YFAC=0.01 
IF(IYLAB.EQ.6) YFAC=0.001 
IFUYIAB.EQ.7) YFAC=0.0001 
YMIN=YMIN*YFAC 
YMAX=YMAX*YFAC 
DO 23 J=1,M 
DO 23 I=1,N 
Y(I,J)=Y(I f J)*YFAC 
23 CONTINUE 
ENDIF 

XLABL(1)=LABLX 

XLABL ( 2 ) = LABFAC ( IXLAB ) 

YLABL(1)=LABLY 

YLABL ( 2 )= LABFAC ( IYLAB ) 

XMAJ=0. 2*(XMAX-XMIN) 

YMA J = 0 . 2 * ( YMAX- YMI N ) 

IC0LR=4 

IFIL=3 

ILIN=1 

CALL QSMODE(MODE) 

IF(IBOARD.NE.l) THEN 
CALL QPREG(0, ICOLR) 

ENDIF 

JCOL1=150 

JC0L2=500 

JROW1=40 

IF(MODE. EQ. 6) JROW1=60 
JROW2=149 

IF(MODE. EQ. 16) JROW2=299 

IF(MODE. EQ. 18) JROW2=419 

XORG=XMIN 

YORG=YMIN 

YOVERX=1.0 

IOPT=0 

IF(MOOE.NE. 18) THEN 
CALL QPTXT(60,TITLE, 7 ,5,23) 

ELSE 

CALL QPTXT (60, TITLE, 7, 5, 29) 

ENDIF 

CALL QPTXT (8 , YLABL ( 1 ) , 7 , 2 , 15 ) 

CALL QPTXT ( 8 , YLABL (2), 7, 2, 14) 

CALL QPLOT ( JCOL1 , JCOL2 , JROW1 , JROW2 , XMIN ,XMAX , YMIN , YMAX , 
* XORG , YORG , IOPT , YOVERX , ASPECT ) 

CALL QSETUP(0, ILIN,-2, IFIL) 

CALL QXAXIS(XMIN , XMAX , 0 . 0 , 0 , 0 , 0 ) 

CALL QPTXTA( 16 , XLABL , 7 ) 

CALL QXAXIS(XMIN,XMAX,XMAJ,0,-1 , 2) 

CALL QYAXIS ( YMIN , YMAX , YMAJ , 0 , - 1 , 2 ) 

DO 24 J=1,M 
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c 


IF(FFAC.EQ.l.O) THEN 
WRITE( FREQL , 1 ) FREQ(J) , RADHER( 1 ) 

ELSE 

WRITE (FREQL , l)FREQ(J) , RADHER(2 ) 
ENDIF 

IF(MOD(J,2).EQ.O) THEN 
CALL QSETUP(0,ILIN+1,-2,IFIL) 

ELSE 

CALL QSETUP(0, ILIN,-2 , IFIL) 

ENDIF 

CALL QT ABL (1,N,X,Y(1,J)) 

CALL QRTOI(X(N) , Y(N, J) , IXPIX, IYPIX) 

IYPIX=IYPIX-5 

IXPIX=IXPIX+2 

CALL QGTXT (16, FREQL , 7 , IXPIX , IYPIX , 0 ) 

24 CONTINUE 

25 CONTINUE 

CALL QONKEY(IKEY) 

IF(IKEY.EQ.O) GO TO 25 
CALL QINKEY(IEXTEN,IKEY) 

CALL QSMODE(MODET) 

IF(IXLAB.NE.l) THEN 
DO 31 1=1 ,N 
X(I)=X(I)/XFAC 

31 CONTINUE 
ENDIF 

IF(IYLAB.NE.l) THEN 
DO 32 J=1,M 
DO 32 1 = 1, N 
Y(I , J)=Y(I, J)/YFAC 

32 CONTINUE 
ENDIF 
RETURN 
END 


SUBROUTINE PLTVAR ( X , Y , N , LABLX , LABLY , FREQ ) 

Plots n vs t for a single frequency 
DIMENSION X(N) ,Y(N) 

CHARACTER*8 LABLX , LABLY , LABFAC ( 7 ) 

CHARACTERS XLABL(2) , YLABL(2) 

COMMON /TITL/TITLE,TITLF, IHR, IMIN,AP,IYR, IMON,IDAY 

COMMON /FFACT/FFAC 

INTEGER*2 IHR,IMIN,IYR,IMON,IDAY 

CHARACTER*2 AP 

CHARACTER* 60 TITLE 

CHARACTER*40 TITLF 

CHARACTER* 2 9 FREQL 

CHARACTER*8 RADHER(2) 

DATA RADHER/’ rad/sec V Hertz 7 
DATA LABFAC/ ’ 


V X 10 
* ’ x-10 
DATA ASPECT/1.35/ 

1 FORMAT ( ’frequency =’,F10.3,A) 


x 100 
x-100 


x 1000 \ 
x-1000 V 
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CALL QRMODE(MODET , NCOLT ) 

CALL QVIDBD(IBOARD) 

I F ( I BOARD . LT . 1 . OR . I BOARD . GT . 3 ) THEN 
WRITEC*,*)’ Graphics board not installed!’ 
RETURN 
ENOIF 

IF(IBOARD.EQ.l) MODE=6 
IF(IBOARD.EQ.2) MODE=16 
IF(IBOARD. EQ. 3) MODE=18 
XMIN=X(1) 

XMAX=X(N) 

YMIN=Y(1) 

YMAX=Y(N) 

DO 21 1=1, N 

IF(XMIN.GT.X(I)) XMIN=X(I) 

IF(XMAX.LT. X(I)) XMAX=X(I) 
IF(YMIN.GT.YCD) YMIN=Y(I) 

IFCYMAX.LT. Y(I )) YMAX=Y (I ) 

21 CONTINUE 

IF(YMIN.GT.O.O) YMIN=0.0 
IXLAB=1 

IFCXMAX.LT. 0.1) IXLAB=2 
IFCXMAX.LT. 0.01) IXLAB=3 
IFCXMAX.LT. 0.001) IXLAB=4 
IFCXMAX.GT. 10.0) IXLAB=5 
IFCXMAX.GT. 100.0) IXLAB=6 
IFCXMAX.GT. 1000.0) IXLAB=7 
IYLAB=1 

IFCYMAX.LT. 0.1) IYLAB=2 
IFCYMAX.LT. 0.01) IYLAB=3 
IFCYMAX.LT. 0.001) IYLAB=4 
IF(YMAX.GT.IO.O) IYLAB=5 
IFCYMAX.GT. 100.0) IYLAB=6 
IFCYMAX.GT. 1000.0) IYLAB=7 
IF(IXLAB.NE.l) THEN 
IFCIXLAB.EQ.2) XFAC=10.0 
IFCIXLAB. EQ. 3) XFAC=100.0 

IFCIXLAB. EQ.4) XFAC=1000.0 

IFCIXLAB. EQ. 5) XFAC=0.01 

IFCIXLAB. EQ. 6) XFAC=0.001 

IFCIXLAB. EQ. 7) XFAC=0.0001 

XMIN=XMIN*XFAC 
XMAX=XMAX*XFAC 
DO 22 1=1, N 
X(I)=X(I)*XFAC 

22 CONTINUE 
ENDIF 

IF(IYLAB.NE.l) THEN 
IFCIYLAB.EQ.2) YFAC=10.0 
IFCIYLAB.EQ.3) YFAC=100.0 
IFCIYLAB.EQ.4) YFAC=1000.0 
IFCIYLAB. EQ. 5) YFAC=0.01 
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I F ( I Y LAB . EQ . 6 ) YFAC=0.001 

IFUYLAB.EQ.7) YFAC=0.0001 
YMIN=YMIN*YFAC 
YMAX=YMAX*YFAC 
DO 23 1=1, N 
Y(I)=Y(I)*YFAC 
23 CONTINUE 
ENDIF 

XLABL(1)=LABLX 

XLABL ( 2 ) = LABFAC ( IXLAB ) 

YLABL(1)=LABLY 

YLABL ( 2 ) = LABFAC ( I YLAB ) 

XMAJ=0.2*(XMAX-XMIN) 

YMAJ=0.2*(YMAX-YMIN) 

IC0LR=4 

IFIL=3 

ILIN=1 

CALL QSMODE(MODE) 

IF(IBOARD.NE.l) THEN 
CALL QPREG(0, ICOLR) 

ENDIF 

JC0L1=150 

JCOL2=500 

JROW1=40 

IF(HODE. EQ. 6) JROW1=60 
JROW2=149 

IF(MODE. EQ. 16) JROW2=299 

IF(MODE. EQ. 18) JROW2=419 

XORG=XMIN 

YORG=YHIN 

YOVERX=1.0 

I0PT=0 

IF(FFAC.EQ.l.O) THEN 
WRITE ( FREQL , 1 ) FREQ , RADHER ( 1 ) 

ELSE 

WRITE ( FREQL , 1 ) FREQ , RADHER ( 2 ) 

ENDIF 

IF(MODE.NE. 18) THEN 
CALL QPTXT(60, TITLE, 7,5,23) 

CALL QPTXT(29 , FREQL ,7,25,22) 

ELSE 

CALL QPTXT(60,TITLE,7,5,29) 

CALL QPTXT(29,FREQL,7,25,28) 

ENDIF 

CALL QPTXT ( 8 , YLABL (1), 7, 2,15) 

CALL QPTXT ( 8 , YLABL (2), 7, 2, 14) 

CALL QPLOT ( JCOL 1 , JCOL2 , JROW1 , JROW2 , XMIN , XMAX , YMIN, YMAX , 
* XORG , YORG , IOPT , YOVERX , ASPECT ) 

CALL QSETUP(0 , ILIN,-2 , IFIL) 

CALL QXAXIS(XMIN, XMAX, 0.0,0, 0,0) 

CALL QPTXTA( 16 , XLABL , 7 ) 

CALL QXAX I S ( XM I N , XMAX , XMA J , 0 , - 1 , 2 ) 
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c 


CALL QYAXIS ( YMIN, YMAX , YMAJ , 0 , - 1 , 2 ) 

CALL QTABL(1,N,X,Y) 

24 CONTINUE 

CALL QONKEY(IKEY) 

IF(IKEY.EQ.O) GO TO 24 
CALL QI N KEY ( I EXT EN , I KEY ) 

CALL QSMODE(MODET) 

25 CONTINUE 
IF(IXLAB.NE.l) THEN 

DO 31 1=1, N 
X(I)=X(I)/XFAC 

31 CONTINUE 
ENDIF 

IF(IYLAB.NE.l) THEN 
DO 32 1=1, N 
Y(I)=Y(I)/YFAC 

32 CONTINUE 
ENDIF 
RETURN 
END 

SUBROUTINE READIN 
Reads Input data 

COMMON /CMPVAL/X1 , Y1 , Z1 , W1 , Ml , PO , PI , UO , U1 , RFH , RFK , RFP , 

* S,GF,GOX,RFA,RFC 

COMMON /RELVAL/N , TAU , DTAU , NR , RBAR , MBAR , GAMMA , POO , DHL DR , CSTAR , 

* DCSDR , RHOLO , ULO , LAMDA , MU , TAUT , UBAR( 50 ) , XBAR ( 50 ) , XLC 
COMMON /INTVAL/NVAL 

COMMON /DIMVAL/HOLDD( 20 ) , XBARD ( 50 ) , PBAR ( 50 ) , TBAR ( 50 ) 

COMMON /TITL/TITLE.TITLF, IHR, IMIN,AP,IYR, IMON, IDAY 
INTEGERS I HR , IMIN , IYR , IMON , IDAY 
CHARACTERS AP 


CHARACTERS TITLE 
CHARACTERS TITLF 
REAL MBAR, N, NR, LAMDA, MU, RVAR(15) 

REAL MBARD , ND , NRD , LAMDAD , MUD , HOLDC 20 ) 

COMPLEX S,X1 , Y1 ,Z1 ,W1 ,M1 ,P0,P1 ,U0,U1 ,GF,GOX,RFH,RFK,RFP, RFA,RFC 
COMPLEX CVAR(17) 

EQUIVALENCE ( N , RVAR( 1 ) ) , (XI , CVAR( 1 ) ) 

EQUIVALENCE (ND,H0LD(1) ) , (TAUD,H0LD(2)) , (DTAUD,H0LD(3) ) , 

* (NRD, H0LD(4)), (LAMDAD, H0LD(5)), (MUD, H0LD(6)), 

* (CDIAM,H0LD(7) ) , (TDIAM,H0LD(8)) , (XLCD,H0LD(9) ) , 

* (GAMMAD,HOLD(10) ) , (RGAS,H0LD(11 ) ) , (POOD,HOLD(12) ) , 

* (MBARD,H0LD(13)) , (RBARD,HOLD( 14) ) , (DCSDRD,HOLD( 15) ) , 

* ( DHLDRD, HOLD( 16) ) , (RHOLOD, HOLD( 17 ) ) , (ULOD , HOLD( 18 ) ) , 

* (PCHMB,HOLD(19)), (TCHMB,HOLD(20) ) 

CHARACTERS VAR ( 20 ) , VARP( 20 ) , VARL ( 20 ) , NAME 
CHARACTERS ANS 

DATA IGO/O/ 

DATA VAR /’ ND TAUD = ’,’ DTAUD = ’ 

* ’ MUD =’,’ CDIAM =’ , ’ TDIAM =’ 

* ’ RGAS =\ ’ POOD = V MBARD = ’ 

* ’DHLDRD =’,’ RHOLOD = ’,’ ULOD=’ 


NRD = ’ , ’ LAMDAD = ’ , 
XLCD =’ , ’GAMMAD =’ , 
RBARD = ’ , ’ DCSDRD = ’ , 
PCHMB =’ , ’ TCHMB =’/ 
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DATA VARP/’ND 

’ , ’TAUD 

’ , ’ DTAUD 

’ , ’NRD 

’ , ’ LAMDAD 

9 

9 

* ’MUD 

’ , ’CDIAM 

’,’TDIAM 

’,’XLCD 

’ , ’GAMMAD 

9 

9 

* ’RGAS 

’ , ’POOD 

’,’ MBARD 

’,’ RBARD 

’ , ’ DCSDRD 

9 

9 

* ’DHLDRD 

’ , ’RHOLOD 

’,’ULOD 

’ , ’ PCHMB 

’ , ’TCHMB 

7 

DATA VARL/’nd 

’ , ’taud 

’ , ’ dtaud 

’,’nrd 

’ , ’ 1 amdad 

i 

9 

* ’mud 

’ , ’cdiam 

’ , ’tdlam 

’,’xlcd 

’ , ’ gammad 

9 

9 

* ’ rgas 

’ , ’ pOOd 

’ , ’mbard 

’ , ’ rbard 

’ , ’dcsdrd 

9 

9 

* ’dhldrd 

’ , ’ rholod 

’,’ulod 

’ , ’ pchmb 

’ , ’tchmb 

7 


1 FORMAT (1615) 

2 FORMAT(4E15. 6) 

3 FORMAT(3E15.6) 

4 FORMAT (A) 

5 FORMAT ( ’ Enter X (ft), P (lbf/fr2), and T (*R) for point 

* 13,’ ’) 

6 FORMAT (1P4E15. 6) 

7 FORMAT ( 2X , A8 , 2X , A8 , 2X , A8 , 2X , A8 , 2X , A8 ) 

8 FORMAT (2X,A8 ,1PE13.5,2X,A8,E13.5,2X,A8,E13.5) 

9 FORMAT ( 1P3E15 . 6 ) 

10 FORMAT (A40, 2X, 12.2, ’ : ’ ,I2.2,A2,3X,I2.2, ’-’ ,12.2, ’-’ ,12.2) 
IF(IGO.EQ.l) THEN 

WRITE(*, ’ (A\) ’ ) ’ Do you wish to use old data with or without chan 
*ges? Y or N ’ 

READ(*,4)ANS 

IF(ANS.EQ. ’Y’.OR.ANS.EQ. ’y’) GO TO 24 
ENDIF 
IGO=l 

WRITE(*,*) ’ ’ 

WRITE(*, ’ (A\) ’ ) ’ Is your rocket input on file? Y OR N ’ 
READ(*,4)ANS 

IF(ANS. NE. ’N’.AND.ANS.NE. ’n’) THEN 

WRITE(*, ’ (A\) ’ ) ’ Does the file need to be rewound? Y OR N ’ 
READ(*,4)ANS 

I F ( ANS . EQ . ’ Y ’ . OR . ANS . EQ . ’ y ’ ) REWINO 15 
READ( 15 ,4, END=99)TITLF 

WRITE (TITLE, 10)TITLF, IHR, IMIN , AP, IMON,IDAY, IYR 
READ( 15,1, END=99)NVAL 
IF(NVAL.EQ.O) GO TO 99 

READ(15, 3) (XBARD(I) ,PBAR(I) ,TBAR(I) , 1=1 ,NVAL) 

PCHMB=PBAR(1) 

TCHMB=TBAR(1) 

READ ( 1 5 , 2 ) ND , TAUD , DTAUD , NRD 
R EAD ( 1 5 , 2 ) LAMDAD , MUD 
READ(15,2)CDIAM,TDIAM,XLCD 
READ( 15 , 2 )GAMMAD , RGAS , POOD 
READ ( 15,2) MBARD , RBARD 
READ ( 1 5 , 2 ) DCSDRD , DHLDRD , RHOLOD , ULOD 
ELSE 

WRITE(*, ’ (A\) ’ ) ’ How many points along centerline? ’ 
READ(*,*,END=99)NVAL 
IF(NVAL.EQ.O) GO TO 99 
DO 21 1=1 , NVAL 
WRITE(* , 5)1 
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READ(*,*)XBARD(I),PBAR(I),TBAR(I) 

21 CONTINUE 

PCHMB=PBAR(1) 

TCHMB=TBAR(1) 

WRITE(*,*)’ Enter Title’ 

READ(*,4)TITLF 

WRITE (TITLE, 10)TITLF, IHR, IMIN,AP, IMON, IDAY, IYR 
WRITE(*,*)’ Enter N (pressure Interaction index) and NR’, 

* ’ (enthalpy Interaction Index)’ 

READ(*,*)ND,NR 

WRITE(*,*)’ Enter TAU (sensitive time lag - sec) and DTAU’, 

* ’ (Invarlent time lag - sec)’ 

READ(*,*)TAUD,DTAUD 

WRITE(*,*)’ Enter LAMDA and MU (real and imaginary parts’, 

* ’ of frequency’ 

READ (*,*)LAMDAD, MUD 

WRITE(*,*)’ Enter XLCD (length of combustion chamber - ft)’ 
READ(*,*)XLCD 

WRITE(*,*)’ Enter CDIAM (chamber diameter - ft) and TDIAM’, 

* ’ (throat diameter - ft)’ 

READ(*,*)CDIAM, TDIAM 

WRITE(*,*)’ Enter GAMMA (ratio of specific heats), RGAS’, 

* ’ (gas constant - ft'‘2/sec , '2/*R) ’ 

READ( * , * )GAMMAD , RGAS 

WRITE(*,*)’ Enter POO (maximum overpressure - lbf/ft''2)’ 
READ(*,*)P00D 

WRITE(*,*)’ Enter MBAR (mean combustion response function 

* ’ lbm/sec)’ 

WRITE(*,*) ’ and RBAR (mean mixture ratio)’ 

READ(* , * )MBARD, RBARD 

WRITE(*,«)’ Enter DCSDR (dc*/dr - ft/sec) and DHLDR ’ , 

* ’ (dh/dr - ft~2/sec~2) ’ 

READ( * , * )DCSDRD, DHLDRD 

WRITE(*,*)’ Enter RHOLO (mass of liquid/unit chamber vol 

* ’lbm/ft~3)’ 

WRITE(*,*)’ and ULO (axial component of liquid velocity’, 

* ’ - ft/sec)’ 

READ(*,*)RHOLOD,ULOD 
WRITE(15,4)TITLF 
WRITE(15, 1)NVAL 

WRITE(15, 9) (XBARD(I ) , PBAR(I) ,TBAR(I) , I=1,NVAL) 
WRITE(15,6)ND, TAUD , DTAUD , NR 
WRITE(15,6) LAMDAD , MUD 
WRITE( 15 , 6 )CDIAM , TDIAM , XLCD 
WRITE ( 15,6 )GAMMAD , RGAS , POOD 
WRITE(15,6)MBARD,RBARD 
WRITE ( 1 5 , 6 ) DCSDRD , DHLDRD , RHOLOD , ULOD 
ENDIF 

CALL NONDIM(HOLD) 

RETURN 
24 CONTINUE 

WRITE(*, ’ (A\) ’ ) ’ are there any changes? Y or N * 
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READ(*,4)ANS 

IF(ANS.NE. ’Y’.AND.ANS.NE. ’y’) THEN 
CALL NONDIM(HOLD) 

RETURN 

ENDIF 

WRITEC* , ’ (A\) ’ ) ’ Do you wish to change title? Y or N 
READ(* , 4)ANS 

IF(ANS. EQ. ’Y’ .OR.ANS. EQ. ’y’ ) THEN 
WRITEC*,*)’ Enter Title’ 

READ(*,4)TITLF 

WRITE (TITLE, 10 )TITLF, IHR, IMIN,AP, IMON, IDAY, I YR 
ENDIF 


GO TO 29 
27 CONTINUE 
WRITEC*,*)’ 
WRITEC*,*) ’ 
WRITEC*,*)’ 
WRITEC*,*)’ 
WRITEC*,*)’ 
WRITEC*,*)’ 
WRITEC*,*)’ 
WRITEC* , *) ’ 
WRITEC*,*) ’ 
WRITEC*,*)’ 
WRITEC*,*)’ 
WRITEC*,*) ’ 
WRITEC*,*) ’ 


VARIABLE NAMES AND DESCRIPTIONS’ 

9 

ND - pressure interaction index' 
TAUD - sensitive time lag 
DTAUD - invariant time lag 
NRD - enthalpy Interaction Index’ 
LAMDAD - damping of perturbation’ 

MUD - frequency of perturbation’ 

CDIAM - chamber diameter 

TDIAM - throat diameter 

XLCD - length of combustion chamber 

GAMMAD - ratio of specific heats’ 

RGAS 


- gas constant 

* ’ (ft/sec)~2/‘R’ 

WRITEC*,*) ’ POOD - maximum pressure 

* ’lbf/ft"2’ 

WRITEC*,*)’ MBARD - mean combustion response funct. 

* ’lbm/sec’ 

WRITEC*,*)’ RBARD - mean mixture ratio’ 

WRITEC*,*)’ DCSDRD - d(c*)/d(mixture ratio) 
WRITEC*,*)’ DHLDRD - d(enthalpy)/d(mixture ratio) 

* ’ft~2/sec~2’ 


WRITEC*,*)’ RHOLOD - mass of liquid/unit chamber volume 

* Mbm/ft^’ 

WRITEC*,*)’ ULOD - axial component of liquid velocity 
WRITEC*,*)’ PCHMB - chamber pressure at Injector 

* ’lbf/ft~2’ 

WRITEC*,*)’ TCHMB - chamber temperature 
WRITEC*,*)’ ’ 

GO TO 30 

28 CONTINUE 

WRITEC*,*)’ VARIABLE NAMES AND VALUES’ 

WRITEC*,*)’ ’ 

WRITEC*, 8)(VAR(I),HOLD(I), 1=1, 20) 

29 CONTINUE 
WRITEC*,*)’ ’ 

WRITEC*,*)’ Enter ? to print variable names & descriptions 
WRITEC*,*)’ # to print variable names & values’ 


sec’ 

sec’ 


ft’ 

ft’ 

ft’ 

l 

9 


9 


9 


ft/sec’ 

9 

9 

9 

9 

ft/sec’ 

9 


‘R’ 
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WRITE (*,*) ’ END when all changes have been made’ 

WRITER,*)’ ’ 

30 CONTINUE 

WRITE(*, ’ (A\) ’ ) ’ Enter variable name and new value, END, ?, or # 
* ’ 

CALL ZREAD( NAME, VALUE) 

IF(NAME.EQ. ’?’) GO TO 27 
IF(NAME.EQ. ’#’) GO TO 28 
IFCNAME.EQ. ’END’ .OR. NAME. EQ. ’end’) THEN 
CALL NONDIM(HOLD) 

RETURN 

ENDIF 

DO 31 11=1,20 
I = II 

IF(NAME.EQ.VARP(I).OR.NAME.EQ.VARL(I)) GO TO 32 

31 CONTINUE 

WRITE (*,*) ’ Invalid name, try again’ 

GO TO 27 

32 CONTINUE 
HOLD(I)=VALUE 
GO TO 30 

99 CONTINUE 
STOP 
END 

SUBROUTINE SETVAL(VAL.ID) 

C Sets value from Iterated variable 

COMMON /DIMVAL/HOLDD ( 20 ) , XBARD( 50 ) , PBAR( 50 ) , TBAR ( 50 ) 

VAL=HOLDD(ID) 

RETURN 

END 

SUBROUTINE SETVAR(VAL, ID) 

C Sets Iterated variable from value 

COMMON /CMPVAL/X1 ,Y1,Z1,W1,M1,P0,P1,U0,U1,RFH,RFK,RFP, 

* S , GF , GOX , RFA , RFC 

COMMON /RELVAL/N , TAU , DTAU , NR , RBAR , MBAR , GAMMA , POO , DHLDR , CSTAR , 

* DCSDR , RHOLO , ULO , LAMDA , MU , TAUT , UBAR( 50 ) , XBAR( 50 ) , XLC 
COMMON /RESULT/PP , UP , SIGP , FUNB 

COMMON /INTVAL/NVAL 

COMMON /DIMVAL/HOLDD( 20 ) , XBARD( 50 ) , PBAR( 50 ) , TBAR( 50 ) 

REAL MBAR, N, NR, LAMDA, MU, RVAR(13) 

REAL MBARD , ND , NRD , LAMDAD , MUD 

COMPLEX S,X1 ,Y1 ,Z1 ,W1,M1,PO,P1,UO,U1,GF,GOX,RFH,RFK,RFP,RFA,RFC 
COMPLEX PP , UP , SIGP , FUNB , CVAR( 17 ) 

EQUIVALENCE ( N , RVAR( 1 ) ) , (XI , CVAR( 1 ) ) 

EQUIVALENCE 

* ( ND , HOLDD ( 1 ) ) , ( TAUD , HOLDD ( 2 ) ) , ( DTAUD , HOLDD( 3 ) ) , 

* (NRD, HOLDD(4)), (LAMDAD, HOLDD(5)) f (MUD, HOLDD(6)), 

* (CDIAM,HOLDD(7)) , (TDIAM,HOLDD(8)) , (XLCD,HOLDD(9) ) , 

* (GAMMAD,HOLDD(10) ) , (RGAS,HOLDD(ll)) , (POOD,HOLDD(12) ) , 

* (MBARD, HOLDD( 13 ) ) , (RBARD,H0LDD(14)) , (DCSDRD,HOLDD(15) ) , 

* ( DHLDRD , HOLDD ( 16 )), ( RHOLOD , HOLDD( 17)), (ULOD , HOLDD ( 18 ) ) , 

* ( PCHMB , HOL DD ( 1 9 ) ) , ( TCHMB , HOLDD ( 20 ) ) 
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DATA PI/3. 141593/, GC/32. 174/ 

HOLDD(ID)=VAl 

IF(ID.EQ.l) THEN 

ND 

N=ND 

RETURN 

ENDIF 

IF(ID. EQ. 2) THEN 

TAUD 

ASTAR=SQRT(GAMMAD*RGAS*TBAR(1) ) 

T AU=T AUD* AST AR/XLCD 
TAUT=TAU+DTAU 
RETURN 
ENDIF 

I F ( ID . EQ. 3) THEN 

DTAUD 

ASTAR=SQRT(GAMMAD*RGAS*TBAR(1) ) 
DTAU= DTAUD* ASTAR/XLCD 
TAUT=TAU+DTAU 
RETURN 
ENDIF 

I F ( I D . EQ . 4 ) THEN 

NRD 

NR=NRD 

RETURN 

ENDIF 

IF(ID. EQ. 5) THEN 

LAMDAD 

AST AR= SQRT ( GAMMAD*RGAS*T BAR ( 1 ) ) 
LAMDA= LAMDAD*XLCD/AST AR 
S=CMPLX ( LAMDA , MU ) 

RETURN 

ENDIF 

IFCID.EQ.6) THEN 

MUD 

ASTAR= SQRT (GAMMAD*RGAS*T BAR ( 1 ) ) 
MU=MUD*XLCD*PI/ASTAR 
S=CMPLX( LAMDA, MU) 

RETURN 

ENDIF 

IFCID.EQ.7) THEN 

CDIAM 

CAREA=0 . 25*PI*CDIAM**2 
ASTAR=SQRT (GAMMAD*RGAS*TBAR( 1 ) ) 

DO 21 1=1 ,NVAL 

RHOBAR= PBAR (I)*GC/( RGAS*T BAR (I)) 
UBARD=MBARD/ ( RHOBAR*CAREA ) 

UBAR ( I ) =UBARD/AST AR 
21 CONTINUE 
RETURN 
ENDIF 

IF( ID. EQ.8) THEN 


C TDIAM 

TAREA=0.25*PI*TDIAM**2 
ASTAR=SQRT (GAMMAD*RGAS*TBAR( 1 ) ) 
CSTARD= PBAR ( NVAL ) *TAREA*GC/MBARD 
CST AR=CST ARD/AST AR 
RETURN 
ENDIF 

IFCID.EQ.9) THEN 
C XLCD 

ASTAR= SQRT ( GAMMAD*RGAS*T BAR ( 1 ) ) 

T AU=T AUD* AST AR/XLCD 

DT AU= DT AUD*AST AR/XLCD 

TAUT=TAU+DTAU 

LAMDA= LAMDAD*XLCD/AST AR 

MU=MUD*XLCD*PI/ASTAR 

S=CMPLX ( LAMDA , MU ) 

DO 22 1=1, NVAL 
XBAR( I )=XBARD( I )/XLCD 

22 CONTINUE 

RETURN 

ENDIF 

IF(ID.EQ.IO) THEN 
C GAMMAD 

GAMMA =GAMMAD 
CAREA=0. 25*PI*CDIAM**2 
TAREA=0 . 25*PI*TDIAM**2 
AST AR= SQRT ( GAMMAD*RGAS*T BAR ( 1 ) ) 
TAU=TAUD*ASTAR/XLCD 
DT AU= DT AUD*AST AR/XLCD 
TAUT=TAU+DTAU 
LAMDA= LAMDAD*XLCD/ASTAR 
MU=MUD*XLCD*PI/ASTAR 
S=CMPLX( LAMDA, MU) 

ULO=ULOD/ASTAR 

DCSDR= DCSDRD/AST AR 

RHOB 1 = PBAR ( 1 ) *GC/ ( RGAS*T BAR ( 1 ) ) 

MBAR=MBARD/ ( RHOB1 *ASTAR*CAREA/XLCD ) 

CSTARD= PBAR ( NVAL ) *TAREA*GC/MBARD 

CST AR= CST ARD/AST AR 

DO 23 1=1, NVAL 

RHOBAR= PBAR ( I ) *GC/ ( RGAS*TBAR (I)) 
UBARD=MBARD/ ( RHOBAR*CAREA ) 
UBAR(I)=UBARD/ASTAR 

23 CONTINUE 

RETURN 

ENDIF 

IF(ID.EQ.ll) THEN 
C RGAS 

CAREA=0. 25*PI*CDIAM**2 
TAREA=0.25*PI*TDIAM**2 
ASTAR=SQRT(GAMHAD*RGAS*TBAR(1) ) 

T AU=TAUD* AST AR/XLCD 
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DT AU= DT AUD*AST AR/XLCD 

TAUT=TAU+DTAU 

LAMDA= LAMDAD*XLCD/ASTAR 

MU=MUD*XLCD*PI/ASTAR 

S=CMPLX ( LAMDA , MU ) 

ULO=ULOD/ASTAR 

DCSDR= DCSDRD/AST AR 

RH0B1 = PBAR ( 1 ) *GC/ ( RGAS*T BAR ( 1 ) ) 

RHOLO= RHOLOD/RHOB 1 

MBAR=MBARD/(RHOBl*ASTAR*CAREA/XLCD) 

CST ARD=PBAR ( NVAL ) *TAREA*GC/MBARD 

CSTAR= CST ARD/AST AR 

DO 24 1=1, NVAL 

RHOBAR=PBAR( I )*GC/(RGAS*TBAR( I ) ) 
UBARD=MBARD/ ( RHOBAR*CAREA ) 

UBAR ( I ) =UBARD/AST AR 

24 CONTINUE 

RETURN 

ENDIF 

IF(ID.EQ.12) THEN 
C POOD 

POO=POOD/PCHHB 
RETURN 
ENDIF 

IFUD.EQ.13) THEN 
C MBARD 

CAREA=0. 25*PI*CDIAM**2 
TAREA=0.25*PI*TDIAM**2 
ASTAR=SQRT (GAMMAD*RGAS*TBAR ( 1 ) ) 
RHOB1 = PBAR ( 1 ) *GC/ ( RGAS*TBAR ( 1 ) ) 
MBAR= MBARD/ ( RHOB1 *ASTAR*CAREA/XLCD ) 
CSTARD= PBAR ( NVAL ) *T AREA*GC/MBARD 
CST AR= CST ARD/AST AR 
DO 25 1=1, NVAL 

RHOBAR= PBAR ( I ) *GC/ ( RGAS*T BAR (I)) 
UBARD=MBARD/ ( RHOBAR*CAREA ) 

UBAR ( I ) = UBARD/AST AR 

25 CONTINUE 

RETURN 

ENDIF 

IF( ID. EQ. 14) THEN 
C RBARD 

RBAR=RBARD 
RETURN 
ENDIF 

IF(ID.EQ.15) THEN 
C DCSDRD 

ASTAR=SQRT(GAMMAD*RGAS*TBAR( 1 ) ) 
DCSDR= DCSDRD/AST AR 
RETURN 
ENDIF 

IFUD.EQ.16) THEN 
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DHLDRD 


DHLDR=DHLDRD 

RETURN 

ENDIF 

I F ( ID « EQ. 17 ) THEN 

RHOLOD 

RH0B1= PBAR ( 1 ) *GC/ ( RGAS*TBAR ( 1 ) ) 
RHOLO= RHOLOD/RHOB 1 
RETURN 
ENDIF 

IFUD.EQ.18) THEN 

ULOD 

ASTAR=SQRT(GAMMAD*RGAS*TBAR( 1 ) ) 
ULO=ULOD/ASTAR 
RETURN 
ENDIF 

IF(ID.EQ.19) THEN 

PCHMB 

CAREA=0. 25*PI*CDIAM**2 
TAREA=0. 25*PI*TDIAM**2 
ASTAR=SQRT(GAMMAD*RGAS*TBAR( 1 ) ) 
FAC=PCHMB/PBAR( 1 ) 

DO 26 I=1,NVAL 
PBAR ( I ) = FAC*PBAR ( I ) 

RHOBAR= PBAR (I)*GC/( RGAS*T BAR (I)) 
UBARD=MBARD/ ( RHOBAR*CAREA ) 

UBAR ( I ) =UBARD/AST AR 

26 CONTINUE 

CSTARD= PBAR (NVAL) *T AREA*GC/MBARD 
CST AR= CST ARD/AST AR 
RHOBl=PBAR(l)*GC/(RGAS*TBAR(l)) 
RHOLO=RHOLOD/RHOBl 
MBAR=MBARD/ ( RHOB1 *ASTAR*CAREA/XLCD ) 
P00= POOD/PCHMB 
RETURN 
ENDIF 

IF(ID. EQ. 20) THEN 

TCHMB 

DO 27 1=1, NVAL 
TBAR( I )=FAC*TBAR( I ) 

27 CONTINUE 

CAREA=0.25*PI*CDIAM**2 
TAREA=0. 25*PI*TDIAM**2 
ASTAR=SQRT(GAMMAD*RGAS*TBAR( 1 ) ) 
FAC=T CHMB/TBAR ( 1 ) 

DO 28 1=1, NVAL 

RHOBAR= PBAR ( I ) *GC/ ( RGAS*TBAR (I) ) 
UBARD=MBARD/ ( RHOBAR*CAREA ) 

UBAR ( I ) = UBARD/AST AR 

28 CONTINUE 

CSTARD=PBAR ( NVAL ) *TAREA*GC/MBARD 
CST AR= CST ARD/AST AR 


RH0B1 = PBAR ( 1 ) *GC/ ( RGAS*TBAR ( 1 ) ) 
RHOLO=RHOLOD/RHOB1 
MBAR=MBARD/ ( RHOBl*ASTAR*CAREA/XLCD ) 
ENDIF 
RETURN 


SUBROUTINE ZREAD(NAME, VALUE) 

Reads input for Input modification 
CHARACTER* 1 NAME(8) 

CHARACTER* 1 CARD(80 ) , PLUS , MINUS , PERIOD , LE , E , NUMBER ( 10 ) 
CHARACTER* 1 LEND( 3 ) , CEND( 3 ) , POUND , QUEST , BLK , COMMA 
CHARACTER*80 DCARD 
EQUIVALENCE (CARD(l) , DCARD) 

DATA PLUS/’ + 7, MINUS/’ -7, PERIOD/’ . ’/.LE/’e’/.E/’E’/.BLK/’ ’/ 
DATA NUMBER/’O’ , ’1’ , ’2’ , ’3’ , ’4’ , ’5’ , ’6’ , ’7’ , ’8’ , ’9’/, COMMA/’ , ’/ 
DATA LEND/’e’ , ’n’ , ’d’/,CEND/’E’ , ’N’ , ’D’/, POUND/’#’/, QUEST/’?’/ 

1 FORMAT (A) 

DO 21 1=1,8 
NAME(I)=BLK 
21 CONTINUE 

READ (*,1) DCARD 
IF(CARD(1).EQ. POUND) THEN 
NAME(l)=POUND 
RETURN 


ENDIF 

IF(CARD(1).EQ. QUEST) THEN 
NAME(1)=QUEST 
RETURN 
ENDIF 


00 22 1=1,3 

IF(CARD(I).NE.LEND(I).AND.CARD(I).NE.CEND(I)) GO TO 23 
NAME(I)=CEND(I) 

22 CONTINUE 
RETURN 

23 CONTINUE 

DO 24 1=1,8 
II=I 

IF(CARD(I).EQ. BLK. OR. CARD(I).EQ. COMMA) GO TO 25 
NAME(I)=CARD(I) 

24 CONTINUE 

25 CONTINUE 


DO 26 1=11,80 
ID=I 

IF(CARD(I).NE. BLK. AND. CARD(I).NE. COMMA) GO TO 27 
26 CONTINUE 
VALUE=0.0 

WRITE(*,*)’ No value given, ZERO assumed’ 

RETURN 


27 CONTINUE 
SZGNsl.O 

IF( CARD( ID). EQ. MINUS) THEN 
SIGN=-1 . 0 
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ID=ID+1 

ELSEIF(CARD(ID) . EQ.PLUS) THEN 
ID=ID+1 
ENDIF 
WHOLE=0.0 
DO 30 I=ID,80 
II=I 

IF(CARD(I).EQ. PERIOD) GO TO 31 
IF(CARD( I). EQ.PLUS) GO TO 36 
IF(CARD(I) . EQ. MINUS) GO TO 36 
IF(CARD(I) . EQ. E.OR.CARD(I) . EQ. LE) GO TO 35 
DO 28 J=1 , 10 
JJ=J-1 

I F( CARD (I ) . EQ . NUMBER ( J ) ) GO TO 29 

28 CONTINUE 

VALUE=SIGN*WHOLE 

IF(CARD(I) . EQ.BLK) RETURN 

WRITE(*,*) ’ Input error, value set to ZERO’ 

VALUE=0. 0 

RETURN 

29 CONTINUE 

WHOLE=WHOLE*10. 0+JJ 

30 CONTINUE 
VALUE=SIGN*WHOLE 
RETURN 

31 CONTINUE 
ID=II+1 
FRACT=0. 0 
I COUNT =0 

DO 34 I=ID,80 
ICOUNT=ICOUNT+l 
II=I 

IF(CARD(I).EQ. PERIOD) THEN 
WRITE(*,*)’ Input error, value set to ZERO’ 
VALUE=0. 0 
RETURN 
ENDIF 

IF(CARD(I). EQ.PLUS) GO TO 36 
IF(CARD(I).EQ. MINUS) GO TO 36 
IF(CARD(I) . EQ. E.OR.CARD(I). EQ. LE) GO TO 35 
DO 32 J=l,10 
JJ=J-1 

IF(CARD(I). EQ.NUMBER(J)) GO TO 33 

32 CONTINUE 

VALUE=SIGN* ( WHOLE+FRACT ) 

IF(CARD(I). EQ.BLK) RETURN 

WRITE(*,*)’ Input error, value set to ZERO’ 

VALUE=0.0 

RETURN 

33 CONTINUE 

FRACT=FRACT+ J J/10 . 0**ICOUNT 

34 CONTINUE 
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VALUE=SIGN*(WHOLE+FRACT) 

RETURN 

35 CONTINUE 
11 = 11+1 

36 CONTINUE 

VALUE=SIGN*(WHOLE+FRACT) 

SIGN=1.0 

IF(CARD(II).EQ. MINUS) THEN 
SIGN=-1 . 0 
11 = 11+1 

ELSEIF(CARD(II ) . EQ.PLUS) THEN 
11 = 11+1 
ENDIF 
WHOLE=0.0 
DO 39 1=11,80 
DO 37 J=l,10 
JJ=J-1 

IF(CARD(I).EQ. NUMBER! J)) GO TO 38 

37 CONTINUE 

VALUE=VALUE* 10 . 0** ( SIGN*WHOLE ) 

IF(CARD(I).EQ.BLK) RETURN 

WRITE!*,*)’ Input error, value set to ZERO’ 

VALUE=0.0 

RETURN 

38 CONTINUE 

WHOLE=WHOLE*10 . 0+ J J 

39 CONTINUE 

VALUE=VALUE*10. 0**(SIGN*WHOLE) 

RETURN 

END 
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